Copy and paste data from multiple workbooks last row to a worksheet in another Workbook

Question

The code I've tweaked from another similar post, copies Row 3 to the last row which contains data from 'Sheet1' from all the workbooks in a folder into the 'SH Dealing yyyy.xlsx' 'DealSlips' sheet (adding to the rows here as it sweeps down through the workbooks in the folder). However, it only copies the last row which has data in Column A. In the last row there may be data just in Column J or Column Z for example and it doesn't see these and they are not copied? I'm new to coding and have been pretty much guessing for a couple of hours what needs changing in the code!

    Sub LoopAllExcelFilesInFolder()

'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim lRow As Long
Dim ws2 As Worksheet
Dim y As Workbook

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
    .Title = "Z:\2016\Deal slips ordered mmddyy\"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"

'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)

Set y = Workbooks.Open("Z:\2016\Report\SH Dealing yyyy.xlsx")
Set ws2 = y.Sheets("DealSlips")

'Loop through each Excel file in folder
Do While myFile <> ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Copy data on "Sheet1" sheet to "DealSlips" Sheet in other workbook
    With wb.Sheets("Sheet1")
       lRow = .Range("A" & Rows.Count).End(xlUp).Row
       ' lastRow = Sheets("Sheet1").Range("J" & Rows.Count).End(xlUp).Row
       .Range("A3:Z" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2)
    End With

    wb.Close SaveChanges:=True
    'Get next file name
    myFile = Dir
Loop

'Message Box when tasks are completed
MsgBox "Task Complete!"

ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Answer 1

You can get your desired result by changing the following line:

lRow = .Range("A" & Rows.Count).End(xlUp).Row

With:

lRow = .UsedRange.Rows.Count

Your original code will count the number of rows on a specific column, in your case Column A, whereas the one using UsedRange will look at the last row on your Sheet including cells that contain formatting only.

UPDATE:

Another way to find the last row without counting the cells with formatting would be as below:

Dim lRow As Long, lRow2 As Long
lRow = wb.Sheets("Sheet1").Cells.Find(What:="*", _
        After:=wb.Sheets("Sheet1").Range("A1"), _
        Lookat:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row

 wb.Sheets("Sheet1").Range("A3:Z" & lRow).Copy

 lRow2 = ws2.Cells.Find(What:="*", _
        After:=ws2.Range("A1"), _
        Lookat:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row
 ws2.Range("A" & lRow2).PasteSpecial xlPasteAll

UPDATE 2:

After looking at your code a little close I realized that the lRow2 was throwing an error because the Sheet was actually blank, so I've added a line of code to add a "Header" to cell A1, so that it can calculate the last row appropriately, also I don't understand how you get the "Correct" result manually when I did it I got many more rows than you, but please check the code below, it worked for me (I think), I also moved the workbook with code (i.e. Book1.xlsm) outside the folder you are looping through and added an If statement to exclude the "SH Dealing yyyy.xlsx" workbook from the loop :

Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook, y As Workbook
Dim myPath As String, myFile As String, myExtension As String
Dim FldrPicker As FileDialog
Dim lRow As Long, lRow2 As Long
Dim ws2 As Worksheet

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
    .Title = "Z:\2016\Deal slips ordered mmddyy\"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"

'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)

Set y = Workbooks.Open("Z:\2016\Report\SH Dealing yyyy.xlsx")
'amen
Set ws2 = y.Sheets("DealSlips")

'Loop through each Excel file in folder
Do While myFile <> ""
    If Left(myFile, 2) <> "SH" Then
        'Set variable equal to opened workbook
        Set wb = Workbooks.Open(Filename:=myPath & myFile)

        'Copy data on "Sheet1" sheet to "DealSlips" Sheet in other workbook
    lRow = wb.Sheets("Sheet1").Cells.Find(What:="*", _
            After:=wb.Sheets("Sheet1").Range("A1"), _
            Lookat:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Row ' + 1
            y.Sheets("DealSlips").Range("A1").Value = "Header"
    lRow2 = y.Sheets("DealSlips").Cells.Find(What:="*", _
            After:=y.Sheets("DealSlips").Range("A1"), _
            Lookat:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Row + 1
            wb.Sheets("Sheet1").Range("A3:Z" & lRow).Copy ws2.Range("A" & lRow2)

        wb.Close SaveChanges:=True
        'Get next file name
        myFile = Dir
    Else
        myFile = ""
    End If
Loop

'Message Box when tasks are completed
MsgBox "Task Complete!"

ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub