Excel VBA合并工作表报错：复制与粘贴区域大小不匹配（错误1004）

问题场景 #

合并"Open IM"工作表时运行正常，但合并"Open Task"工作表的列时，以下代码触发错误：

OT2sourceCol.EntireColumn.Copy Destination:=.Cells(OT2firstEmptyRow, i) 'Copy the entire column to the "Combined Tasks and Incidents" sheet starting from the first empty row in the target column

报错信息：

Run-time error '1004' You can't paste this here because the Copy area and paste area aren't the same size. Select just one cell in the paste area or an area that's the same size, and try pasting again.

错误原因 #

EntireColumn.Copy会复制整列的所有1048576行，而粘贴目标是从OT2firstEmptyRow开始的位置，此时目标列剩余的可粘贴行数远小于整列行数，导致复制区域和粘贴区域大小不匹配，触发1004错误。

解决方案 #

只复制"Open Task"中对应列的有效数据区域（从表头到最后一行有数据的行），再粘贴到目标表的指定位置。

修改后的关键代码片段 #

替换原"Copying columns from 'Open Task' sheet"部分的错误代码：

'Copying columns from "Open Task" sheet
With ThisWorkbook.Sheets("Combined Tasks and Incidents")
    Dim OT2targetLastCol As Long
    OT2targetLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    For i = 1 To OT2targetLastCol
        Dim OT2targetCol As String
        OT2targetCol = .Cells(1, i).Value 'The name of the column in the "Combined Tasks and Incidents" sheet
        Dim OT2sourceCol As Range
        Set OT2sourceCol = ThisWorkbook.Sheets("Open Task").Range("A:Z").Find(OT2targetCol, LookIn:=xlValues) 'Find the column in the "Open Task" sheet with the same name
        If Not OT2sourceCol Is Nothing Then
            Dim OT2firstEmptyRow As Long
            OT2firstEmptyRow = .Cells(.Rows.Count, i).End(xlUp).Row + 1
            ' 获取Open Task当前列的最后一行数据行号
            Dim OT2lastDataRow As Long
            OT2lastDataRow = ThisWorkbook.Sheets("Open Task").Cells(ThisWorkbook.Sheets("Open Task").Rows.Count, OT2sourceCol.Column).End(xlUp).Row
            ' 复制有效数据区域并粘贴
            ThisWorkbook.Sheets("Open Task").Range(OT2sourceCol, ThisWorkbook.Sheets("Open Task").Cells(OT2lastDataRow, OT2sourceCol.Column)).Copy _
                Destination:=.Cells(OT2firstEmptyRow, i)
        End If
    Next i
End With

完整修正代码 #

Sub CombineSheets()
    With ThisWorkbook.Sheets("Open IM")
        .Cells.NumberFormat = "General"
        For i = 1 To .UsedRange.Columns.Count
            .Range(.Cells(1, i), .Cells(.Rows.Count, i).End(xlUp)).TextToColumns Destination:=.Range(.Cells(1, i), .Cells(.Rows.Count, i).End(xlUp)), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
                :=Array(1, 1), TrailingMinusNumbers:=True
        Next i
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Dim lastCol As Long
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = 1 To lastRow
            For j = 1 To lastCol
                If IsEmpty(.Cells(i, j)) Then
                    .Cells(i, j).Value = "ThisCellEmpty"
                End If
            Next j
        Next i
    End With
    
    With ThisWorkbook.Sheets("Open Task")
        .Cells.NumberFormat = "General"
        For i = 1 To .UsedRange.Columns.Count
            .Range(.Cells(1, i), .Cells(.Rows.Count, i).End(xlUp)).TextToColumns Destination:=.Range(.Cells(1, i), .Cells(.Rows.Count, i).End(xlUp)), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
                :=Array(1, 1), TrailingMinusNumbers:=True
        Next i
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = 1 To lastRow
            For j = 1 To lastCol
                If IsEmpty(.Cells(i, j)) Then
                    .Cells(i, j).Value = "ThisCellEmpty"
                End If
            Next j
        Next i
    End With

    'Creating new sheet "Combined Tasks and Incidents"
    ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = "Combined Tasks and Incidents"

    With ThisWorkbook.Sheets("Combined Tasks and Incidents")
        .Cells(1, 1).Value = "Number"
        .Cells(1, 2).Value = "Subject"
        .Cells(1, 3).Value = "Assignment group"
        .Cells(1, 4).Value = "Assigned to"
        .Cells(1, 5).Value = "Count Days"
        .Cells(1, 6).Value = "Company"
        .Cells(1, 7).Value = "Reopen count"
        .Cells(1, 8).Value = "Controllable/Non-Controllable"
        .Cells(1, 9).Value = "Created by"
        .Cells(1, 10).Value = "Channel"
        .Cells(1, 11).Value = "Priority"
        .Cells(1, 12).Value = "Resolved"
        .Cells(1, 13).Value = "Closed"
        .Cells(1, 14).Value = "Reassignment count"
        .Cells(1, 15).Value = "Caller"
        .Cells(1, 16).Value = "State"
        .Cells(1, 17).Value = "On hold reason"
        .Cells(1, 18).Value = "Knowledge"
        .Cells(1, 19).Value = "Category"
        .Cells(1, 20).Value = "Subcategory"
        .Cells(1, 21).Value = "Created"
        .Cells(1, 22).Value = "Day"
        .Cells(1, 23).Value = "Closed"
        .Cells(1, 24).Value = "Contact Type"
    End With

    'Copying columns from "Open IM" sheet
    With ThisWorkbook.Sheets("Combined Tasks and Incidents")
        Dim targetLastCol As Long
        targetLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = 1 To targetLastCol
            Dim targetCol As String
            targetCol = .Cells(1, i).Value 'The name of the column in the "Combined Tasks and Incidents" sheet
            Dim sourceCol As Range
            Set sourceCol = ThisWorkbook.Sheets("Open IM").Range("A:Z").Find(targetCol, LookIn:=xlValues) 'Find the column in the "Open IM" sheet with the same name
            If Not sourceCol Is Nothing Then
                sourceCol.EntireColumn.Copy Destination:=.Cells(1, i) 'Copy the entire column to the "Combined Tasks and Incidents" sheet
            End If
        Next i
    End With

    With ThisWorkbook.Sheets("Combined Tasks and Incidents")
        .Cells.NumberFormat = "General"
        For i = 1 To .UsedRange.Columns.Count
            .Range(.Cells(1, i), .Cells(.Rows.Count, i).End(xlUp)).TextToColumns Destination:=.Range(.Cells(1, i), .Cells(.Rows.Count, i).End(xlUp)), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
                :=Array(1, 1), TrailingMinusNumbers:=True
        Next i
        Dim CTIlastRow As Long
        CTIlastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Dim CTIlastCol As Long
        CTIlastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = 1 To CTIlastRow
            For j = 1 To CTIlastCol
                If IsEmpty(.Cells(i, j)) Then
                    .Cells(i, j).Value = "ThisCellEmpty"
                End If
            Next j
        Next i
    End With

    With ThisWorkbook.Sheets("Combined Tasks and Incidents")
        .Cells(1, 2).Value = "Short Description"
    End With

    'Copying columns from "Open Task" sheet
    With ThisWorkbook.Sheets("Combined Tasks and Incidents")
        Dim OT2targetLastCol As Long
        OT2targetLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = 1 To OT2targetLastCol
            Dim OT2targetCol As String
            OT2targetCol = .Cells(1, i).Value 'The name of the column in the "Combined Tasks and Incidents" sheet
            Dim OT2sourceCol As Range
            Set OT2sourceCol = ThisWorkbook.Sheets("Open Task").Range("A:Z").Find(OT2targetCol, LookIn:=xlValues) 'Find the column in the "Open Task" sheet with the same name
            If Not OT2sourceCol Is Nothing Then
                Dim OT2firstEmptyRow As Long
                OT2firstEmptyRow = .Cells(.Rows.Count, i).End(xlUp).Row + 1
                ' 获取Open Task当前列的最后一行数据行号
                Dim OT2lastDataRow As Long
                OT2lastDataRow = ThisWorkbook.Sheets("Open Task").Cells(ThisWorkbook.Sheets("Open Task").Rows.Count, OT2sourceCol.Column).End(xlUp).Row
                ' 复制有效数据区域并粘贴
                ThisWorkbook.Sheets("Open Task").Range(OT2sourceCol, ThisWorkbook.Sheets("Open Task").Cells(OT2lastDataRow, OT2sourceCol.Column)).Copy _
                    Destination:=.Cells(OT2firstEmptyRow, i)
            End If
        Next i
    End With
End Sub

内容的提问来源于stack exchange，提问作者Fabricio Martinez