將數據從多個工作簿的最后一行復制並粘貼到另一個工作簿中的工作表

Question

我從另一個類似的帖子中調整的代碼，將第 3 行復制到最后一行，其中包含來自文件夾中所有工作簿的“Sheet1”中的數據到“SH Dealing yyyy.xlsx”“DealSlips”表（添加到行在這里，因為它掃過文件夾中的工作簿）。 但是，它只復制在 A 列中有數據的最后一行。例如，在最后一行中，可能只有 J 列或 Z 列中的數據，但它看不到這些數據，也沒有復制它們？ 我是編碼新手，幾個小時以來一直在猜測代碼中需要更改的內容！

    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

您可以通過更改以下行來獲得所需的結果：

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

和：

lRow = .UsedRange.Rows.Count

您的原始代碼將計算特定列上的行數，在您的情況下為列 A，而使用UsedRange將查看工作表上的最后一行，包括僅包含格式的單元格。

更新：

查找最后一行而不計算帶有格式的單元格的另一種方法如下：

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

更新 2：

在仔細查看您的代碼后，我意識到 lRow2 拋出了一個錯誤，因為工作表實際上是空白的，所以我添加了一行代碼來向單元格 A1 添加一個“標題”，以便它可以計算最后一個行適當，我也不明白你是如何手動獲得“正確”結果的帶有代碼（即 Book1.xlsm）的工作簿在您正在循環的文件夾外，並添加了一個 If 語句以從循環中排除“SH Dealing yyyy.xlsx”工作簿：

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