0

我有一个包含大约 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

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

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

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

4

1 回答 1

-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
于 2020-10-18T16:13:27.903 回答