使用vba将多个工作表中的数据提取到一张工作表

Question

我有一个包含大约 50 个工作表的工作簿（工作表 1、工作表 2、工作表 3、......、工作表 50）。

我想把所有的数据都放在一张纸上。 我为此使用了以下代码。

Sub tgr()

    Dim ws As Worksheet
    Dim wsDest As Worksheet

    Set wsDest = Sheets("Sheet1")

    For Each ws In ActiveWorkbook.Sheets
        If ws.Name <> wsDest.Name Then
            'ws.Range("A2", ws.Range("A22:Y500").End(xlToRight).End(xlDown)).Copy
            ws.Range("A12:Y60").Copy
            wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
        'ActiveWorkbook.Save
    Next ws

End Sub

但是此代码不适用于我拥有的所有工作表。 它适用于随机表。

我该怎么做才能使其适用于所有工作表。 （我在每张纸上都有不同的行。）

而且上面的代码运行了很长时间。

Answer 1

以下代码将合并运行代码的工作簿中所有工作表中的数据。

请注意，这只是粘贴值（不是格式或公式）

编辑：只是为了让这个答案更清楚。 使用目标工作簿的完全限定并阻止使用活动工作簿，将保证您循环遍历所有工作表。 我解决了循环遍历所有工作表而不是随机工作表的 OP 请求。 并且还添加了一种方法来加速这个过程。

阅读评论并调整它以满足您的需求：

Public Sub ConsolidateData()

    ' Declare and initialize the destination sheet
    Dim destinationSheet As Worksheet
    Set destinationSheet = ThisWorkbook.Worksheets("Sheet1")
    
    ' Loop through all worksheets in the workbook that is running the script
    Dim sourceSheet As Worksheet
    For Each sourceSheet In ThisWorkbook.Worksheets
        If sourceSheet.Name <> destinationSheet.Name Then
            
            ' Set the source sheet's range
            Dim sourceRange As Range
            Set sourceRange = sourceSheet.UsedRange ' I'm using used range, but you could leave it as you had it in terms of a fixed range: sourceSheet.Range("A12:Y60").Copy
            
            ' Get first available cell in column A (from bottom to top)
            Dim targetCell As Range
            Set targetCell = destinationSheet.Range("A" & destinationSheet.Cells(destinationSheet.Rows.Count, "A").End(xlUp).Row).Offset(1, 0)
            
            ' Resize and assign values from source range (using value2 speeeds up things)
            targetCell.Resize(sourceRange.Rows.Count, sourceRange.Columns.Count).Value2 = sourceRange.Value2
            
        End If
    Next sourceSheet

End Sub