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

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

1 个答案: