VBA - 复制区域和粘贴区域的大小不同错误？

Question

美好的一天！我在下面有这些代码，它给了我一个错误“我们无法粘贴，因为复制区域和粘贴区域的大小不同”。请帮助这些代码有什么问题... :(

Option Explicit

Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True


Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

For Each sh In ActiveWorkbook.Worksheets

    If IsError(Application.Match(sh.Name, _
                                 Array(DestSh.Name, "Information"), 0)) Then

        Last = LastRow(DestSh)

        If sh.Name = "Sheet1" Then
            Set CopyRng = sh.Range("A:G")
        End If

        If sh.Name = "Sheet2" Then
            Set CopyRng = sh.Range("B:G")
        End If

        If sh.Name = "Sheet3" Then
            Set CopyRng = sh.Range("C:G")
        End If

        CopyRng.Copy
        With DestSh.Cells(Last + 1, "A")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With

    End If
Next

 ExitTheSub:

Application.GoTo DestSh.Cells(1)

DestSh.Columns.AutoFit

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
 End Sub

下面是我的功能

Option Explicit

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(what:="*", _
                        After:=sh.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(what:="*", _
                        After:=sh.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
On Error GoTo 0
End Function

Answer 1

您的源范围定义为Full Columns。因此，您不能将它们粘贴到目标工作表第一行以外的任何地方。

请记住，工作表中的行数是有限的：1048576 Excel 2007 和更高版本中的行（65536 Excel 2003 中的行）。因此，当您尝试将整列粘贴到不在第一行的某个位置时，副本将超过目标中最后一个可用行。

您可以做的是只取源列的已使用部分，希望在目标工作表中有空间容纳它们。为此，请更改定义源范围的方式，以便仅获取使用过的部分。即：

Set CopyRng = sh.UsedRange.Columns("A:G")
'               ^^^^^^^^^^^^^^^^^^^

对设置 CopyRng 的所有情况执行相同操作。

或者，您可以按照与目标工作表相同的方式查找源工作表的最后使用的行和最后使用的列。此选项应该更准确、更安全。