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

您已从其他地方复制了此内容，而您忘记复制获取工作表最后一行的函数，即此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 2

尝试动态查找最后一行，而不是使用.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

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

Answer 3

将另一种方法投入混合。这确实假设您复制的数据在列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

我希望将多张纸合并为一张合并纸

3 个答案: