Paste to next available ROW

[Ace71425]

I need help! .... I have this code that pastes multiple sheets into a master sheet...it works great BUT the code copies the next sheet of data to the next available cell in the A column. This doesn't work for me when there is info in B, C, and D because it cuts that data off. How can I alter this code to look for the next available blank ROW between the range of A-D whereas they are all empty?

Sub runallmacros()

    Dim wbSource As Workbook
    Dim wsDest As Worksheet
    Dim row As Integer, os As Integer
    
    Set wsDest = ThisWorkbook.Worksheets("File Copier")
    
    row = 2
    os = 0
    
    With wsDest
        Do While .Range("K" & row).Value <> ""
            Set wbSource = Workbooks.Open(wsDest.Range("K" & row).Value)
            wbSource.Worksheets(1).Range("A5:D500").Copy
            Application.DisplayAlerts = False
            wbSource.Close
            Application.DisplayAlerts = True
            If .Range("A1").Value <> "" Then os = 1
            .Range("A" & .Rows.Count).End(xlUp).Offset(os).PasteSpecial
            row = row + 1
        Loop
    End With
    
    Set wbSource = Nothing
    
End Sub

 

[Rick Rothstein]

I need help! .... I have this code that pastes multiple sheets into a master sheet...it works great BUT the code copies the next sheet of data to the next available cell in the A column. This doesn't work for me when there is info in B, C, and D because it cuts that data off. How can I alter this code to look for the next available blank ROW between the range of A-D whereas they are all empty?

Sub runallmacros()

    Dim wbSource As Workbook
    Dim wsDest As Worksheet
    Dim row As Integer, os As Integer
    
    Set wsDest = ThisWorkbook.Worksheets("File Copier")
    
    row = 2
    os = 0
    
    With wsDest
        Do While .Range("K" & row).Value <> ""
            Set wbSource = Workbooks.Open(wsDest.Range("K" & row).Value)
            wbSource.Worksheets(1).Range("A5:D500").Copy
            Application.DisplayAlerts = False
            wbSource.Close
            Application.DisplayAlerts = True
            If .Range("A1").Value <> "" Then os = 1
            .Range("A" & .Rows.Count).End(xlUp).Offset(os).PasteSpecial
            row = row + 1
        Loop
    End With
    
    Set wbSource = Nothing
    
End Sub

Try replacing the highlighted line of code with this...

  .Range("A" & .Columns("A:D").Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row).Offset(1).PasteSpecial