我希望将多张工作表合并为一张合并工作表

Question

想要创建一个宏来循环遍历工作簿中的所有工作表并从每个工作表中选择所有数据，然后将所述数据粘贴到“主”工作表上的单个合并表中。所有工作表都有相同的列标题到“AB”列。

目前尝试使用此代码，但我无法将任何内容粘贴到主工作表上。可能会过度考虑设置每个选项卡的范围。

只是寻找一个简单的解决方案来复制每个工作表中的所有活动数据并将其粘贴到一个工作表中，以便将其全部合并。

提前致谢！

Sub CombineData()
Dim wkstDst As Worksheet
Dim wkstSrc As Worksheet
Dim WB As Workbook
Dim rngDst As Range
Dim rngSrc As Range
Dim DstLastRow As Long
Dim SrcLastRow As Long

'Refrences
Set wkstDst = ActiveWorkbook.Worksheets("Master")


'Setting Destination Range
Set rngDst = wkstDst.Cells(DstLastRow + 1, 1)

'Loop through all sheets exclude Master
For Each wkstSrc In ThisWorkbook.Worksheets
   If wkstSrc.Name <> "Master" Then

        SrcLastRow = LastOccupiedRowNum(wkstSrc)
        With wkstSrc
            Set rngSrc = .Range(.Cells(2, 1), .Cells(SrcLastRow, 28))
            rngSrc.Copy Destination:=rngDst
        End With

        DstLastRow = LastOccupiedRowNum(wkstDst)
        Set rngDst = wkstDst.Cells(DstLastRow + 1, 1)

    End If

 Next wkstSrc


End Sub

Answer 1

加入另一种方法。这确实假设您正在复制的数据在 A 列中的行数与在任何其他列中的行数一样多。它不需要你的函数。

Sub CombineData()

Dim wkstDst As Worksheet
Dim wkstSrc As Worksheet
Dim rngSrc As Range

Set wkstDst = ThisWorkbook.Worksheets("Master")

For Each wkstSrc In ThisWorkbook.Worksheets
   If wkstSrc.Name <> "Master" Then
        With wkstSrc
            Set rngSrc = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 28)
            rngSrc.Copy Destination:=wkstDst.Cells(Rows.Count, 1).End(xlUp)(2)
        End With
    End If
Next wkstSrc

End Sub

Answer 2

你从其他地方复制了这个，你忘记复制获取工作表最后一行的函数，即这个LastOccupiedRowNum

所以将这个函数添加到同一个模块中，代码应该可以工作。如果它确实有效，请不要忘记将其标记为正确答案：

Function LastOccupiedRowNum(Optional sh As Worksheet, Optional colNumber As Long = 1) As Long
    'Finds the last row in a particular column which has a value in it
    If sh Is Nothing Then
        Set sh = ActiveSheet
    End If
    LastOccupiedRowNum= sh.Cells(sh.Rows.Count, colNumber).End(xlUp).row
End Function

Answer 3

尝试动态查找最后一行，而不是使用 .cells

Dim lrSrc as Long, lrDst as Long, i as Long
For i = 1 to Sheets.Count
    If Not Sheets(i).Name = "Destination" Then
        lrSrc = Sheets(i).Cells( Sheets(i).Rows.Count,"A").End(xlUp).Row
        lrDst = Sheets("Destination").Cells( Sheets("Destination").Rows.Count, "A").End(xlUp).Row
        With Sheets(i)
            .Range(.Cells(2,"A"), .Cells(lrSrc,"AB")).Copy Sheets("Destination").Range(Sheets("Destination").Cells(lrDst+1,"A"),Sheets("Destination").Cells(lrDst+1+lrSrc,"AB"))
        End With
    End If
 Next i

这应该替换您的 sub 和相关功能。