復制工作表錯誤：復制區域和粘貼區域的大小不同

Question

我創建了代碼來使用循環復制名為“All-PID”的第一個工作表上的所有 25 個動態工作表。

我能夠運行較早的很長的代碼，現在卡在一條錯誤消息上。

Sub Consolidation()
    
    'Create All-PID Worksheet
    
    Sheets("PMCC-1").Select
    Sheets("PMCC-1").Copy Before:=Sheets(1)
    Sheets("PMCC-1 (2)").Select
    Sheets("PMCC-1 (2)").Name = "All-PID"
    
    Application.ScreenUpdating = False
    
    'Copy PMCC-2 upto PMCC-25 to "All-PID" Worksheet
    
    Dim ws As Worksheet
    
    For Each ws In ThisWorkbook.Worksheets 
        If ws.Name <> "PMCC-1" Then 
            Dim s1 As Excel.Worksheet
            Dim s2 As Excel.Worksheet
            Dim iLastCellS1 As Excel.Range
            Dim iLastRowS2 As Long
    
            Set s1 = Sheets("All-PID")
            Set s2 = ActiveSheet
    
            iLastRowS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Row
            Set iLastCellS1 = s1.Cells(s1.Rows.Count, "A").End(xlUp).Offset(1, 0)
            s2.Range("A2", s2.Cells(iLastRowS2, "W")).Copy iLastCellS1
        End If
    Next ws
End Sub

似乎卡在s2.Range("A2", s2.Cells(iLastRowS2, "W")).Copy iLastCellS1 。

錯誤信息是

運行時錯誤“1004”
"這里不能粘貼，因為復制區域和粘貼區域不是
一樣的大小”。

Answer 1

兩個工作表（“All-PID”和“PMCC-1”）應該從循環中排除，因為“PMCC-1”的內容已經在“All-PID”表中。

Option Explicit
Sub Consolidation()
    
    Worksheets("PMCC-1").Copy Before:=Sheets(1)
    Sheets("PMCC-1 (2)").Select
    Sheets("PMCC-1 (2)").Name = "All-PID"

    Application.ScreenUpdating = False
 
    Dim wsDest As Excel.Worksheet
    Dim ws As Excel.Worksheet
               
    Set wsDest = Sheets("All-PID")
    Set ws = ActiveSheet
    
    For Each ws In ActiveWorkbook.Worksheets
        Select Case ws.Name
        Case Is = "All-PID", "PMCC-1"
        Case Else
            Dim iLastRowS2 As Long
            iLastRowS2 = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            Dim iLastCellS1 As Excel.Range
            Set iLastCellS1 = wsDest.Cells(wsDest.Rows.Count, A").End(xlUp).Offset(1,0)
            ws.Range("A2", ws.Cells(iLastRowS2, "W")).Copy iLastCellS1

        End Select
            
    Next ws

End Sub

Answer 2

我已將您的代碼重構為應該有效且更具可持續性的內容。 我在一些我修改過的 VBA Excel 編碼原則中進行了評論。

Option Explicit

Sub Consolidation()

    Application.ScreenUpdating = False

    'Create All-PID Worksheet
    '**** - Work directly with object ***
    Worksheets("PMCC-1").Copy Before:=Sheets(1)

    Dim pmcc As Worksheet
    Set pmcc = ActiveSheet
    pmcc.Name = "All-PID"

    'Copy PMCC-2 upto PMCC-25 to "All-PID" Worksheet
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> pmcc.Name Then

            With ws '**** - No need to recreate variables ... also with block can make code easier to read and write and understand***

                Dim lastRow As Long
                lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

                Dim copyRange As Range
                Set copyRange = .Range("A2:W" & lastRow)

            End With

            With pmcc '**** - resize is VERY useful. I assume you don't need formulas copied, if so, i can edit answer
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Value
            End With

        End If

    Next ws

End Sub