如何将工作簿中的非连续单元格复制到另一个工作簿中的一组不同的非连续单元格？答案

【问题标题】：How can I copy non-contiguous cells from a workbook to a different set of non-contiguous cells in another workbook?如何将工作簿中的非连续单元格复制到另一个工作簿中的一组不同的非连续单元格？
【发布时间】：2014-01-28 20:34:10
【问题描述】：

我有一个用户复制的 Master 空白工作簿，用于记录一年的信息。主空白允许用户指向去年的“旧”工作簿，将适当数量的行插入新的以匹配旧的，然后将两个不同的连续范围从旧的复制/粘贴到“新”中的匹配范围中空白工作簿。

现在，我希望它将旧工作表上非连续列的总计值复制到新工作表上不同的非连续单元格中。

每个用户的总数位于不同的行，因此我使用 lastrow 函数来查找行号。但似乎我不能用它来定义不连续的范围。

所有代码都包含在下面。您会注意到一个部分，我正在尝试使用范围上的 Union 将旧工作表中的所有数据复制到新工作表中，因为它也是一堆不连续的单元格，但它也不起作用。如果我解决了第一个问题，我应该能够适应第二个问题。

编辑：
我修改了“联合”部分，现在选择了所有正确的单元格，但 Selection.Copy 失败。有什么办法？

编辑#2：
我添加了 Master 空白和用户文件的两个屏幕截图。很容易看到a）行数不同，b）阴影区域是我希望复制/粘贴的区域（在代码的“联合”部分中）。在接下来的一对截图中，需要将用户文件的红绿单元格导入到Master空白文件对应的红绿单元格中。

Option Explicit
Sub UpdateFromOld()

Dim fd As FileDialog
Dim NewWbk As Workbook, OldWbk As Workbook
Dim vrtSelectedItem As Variant, fname As Variant
Dim cella As Range, cellb As Range, cell1 As Range, cell2 As Range
Dim wsh As Worksheet, wsh2 As Worksheet
Dim WshName As String, WshName2 As String
Dim Answer1 As String, Answer2 As String
Dim UsedRange1 As Range, UsedRange2 As Range
Dim InputRange As Range, InputRange1 As Range, InputRange2 As Range, InputRange3 As Range, InputRange4 As Range, InputRange5 As Range
Dim InputRange6 As Range, InputRange7 As Range, InputRange8 As Range, InputRange9 As Range, InputRange10 As Range, InputRange11 As Range
Dim LstYr, ThisYr
Dim ExtraRows As Integer, RowCounter As Integer
Dim SumArray1(24)
Dim MyCell1, cell

On Error GoTo ErrorHandler

Range("B5").Select
WshName = InputBox("Type in your location name", "Annual Ad Planner")
Range("B5").Value = WshName
ActiveSheet.Name = WshName
Set wsh = Worksheets(WshName)

'Application.ScreenUpdating = False

'select the old file to update from
MsgBox "In the next window, navigate to and select the Ad Planner file you are updating from.", vbOKOnly, "Annual Ad Planner"
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .Filters.Add "Previous Ad Planner", "*.xls", 1
    If .Show = -1 Then
        For Each vrtSelectedItem In .SelectedItems
            fname = vrtSelectedItem
        Next vrtSelectedItem
    Else
        MsgBox "You ended the update process.", vbOKOnly, "Annual Ad Planner"
        GoTo ErrorHandler
    End If
End With

Set OldWbk = Workbooks.Open(fname)
OldWbk.Unprotect
Set NewWbk = ThisWorkbook
NewWbk.Unprotect
Set fd = Nothing


NewWbk.Worksheets(WshName).Visible = True
NewWbk.Worksheets(WshName).Activate
NewWbk.Worksheets(WshName).Unprotect
Set cella = Cells(Rows.Count, "A").End(xlUp).Offset(0, 0)

OldWbk.Activate
Range("B5").Select
WshName2 = ActiveCell.Worksheet.Name
Set wsh2 = Worksheets(WshName2)
OldWbk.Worksheets(WshName2).Visible = True
OldWbk.Worksheets(WshName2).Activate
OldWbk.Worksheets(WshName2).Unprotect
Set cellb = Cells(Rows.Count, "B").End(xlUp).Offset(0, 0)

Range("B5").Select
Selection.Copy
NewWbk.Activate
Range("B5").Select
Range("B5").PasteSpecial xlPasteValues

Range("B23").Select
If cellb.Row > cella Then
    ExtraRows = cellb.Row - cella
    For RowCounter = 1 To ExtraRows
        AddRow
    Next RowCounter
End If
NewWbk.Unprotect
NewWbk.Worksheets(WshName).Unprotect

'Copy & Paste list of lead sources
OldWbk.Activate
Range("B20:B" & cellb.Row - 1).Select
Selection.Copy
NewWbk.Activate
Range("B20").Select
Range("B20").PasteSpecial xlPasteValues

'Copy & Paste classifications & segments
OldWbk.Activate
Range("CI20:CK" & cellb.Row - 1).Select
Selection.Copy
NewWbk.Activate
Range("CI20").Select
Range("CI20").PasteSpecial xlPasteValues
Application.CutCopyMode = False

Answer1 = MsgBox("Are you importing last year's file?", vbYesNoCancel, "Annual Ad Planner")
If Answer1 = vbNo Then
    Answer2 = MsgBox("Are you updating the 2014 file?", vbYesNoCancel, "Annual Ad Planner")
    If Answer2 = vbYes Then
        Set InputRange = Union(Range("C3"), Range("C4"), Range("C6"), Range("C7"), Range("C9"), Range("E6"), Range("E7"), Range("E9"), Range("J3"), Range("J4"), Range("J6"), Range("J7"), Range("J9"), Range("L6"), Range("L7"), Range("L9"), Range("Q3"), Range("Q4"), Range("Q6"), Range("Q7"), Range("Q9"), Range("S6"), Range("S7"), Range("S9"), Range("X3"), Range("X4"), Range("X6"), Range("X7"), Range("X9"), Range("Z6")) '30 ranges
        Set InputRange1 = Union(Range("Z7"), Range("Z9"), Range("AE3"), Range("AE4"), Range("AE6"), Range("AE7"), Range("AE9"), Range("AG6"), Range("AG7"), Range("AG9"), Range("AL3"), Range("AL4"), Range("AL6"), Range("AL7"), Range("AL9"), Range("AN6"), Range("AN7"), Range("AN9"), Range("AS3"), Range("AS4"), Range("AS6"), Range("AS7"), Range("AS9"), Range("AU6"), Range("AU7"), Range("AU9"), Range("AZ3"), Range("AZ4")) '28 ranges
        Set InputRange2 = Union(Range("AZ6"), Range("AZ7"), Range("AZ9"), Range("BB6"), Range("BB7"), Range("BB9"), Range("BG3"), Range("BG4"), Range("BG6"), Range("BG7"), Range("BG9"), Range("BI6"), Range("BI7"), Range("BI9"), Range("BN3"), Range("BN4"), Range("BN6"), Range("BN7"), Range("BN9"), Range("BP6"), Range("BP7"), Range("BP9"), Range("BU3"), Range("BU4"), Range("BU6"), Range("BU7"), Range("BU9"), Range("BW6")) '28 ranges
        Set InputRange3 = Union(Range("BW7"), Range("BW9"), Range("CB3"), Range("CB4"), Range("CB6"), Range("CB7"), Range("CB9"), Range("CD6")) '8 ranges
        Set InputRange4 = Union(Range("CD7"), Range("CD9"), Range("C20:D" & cellb.Row - 1), Range("F20:G" & cellb.Row - 1), Range("J20:K" & cellb.Row - 1), Range("M20:N" & cellb.Row - 1), Range("Q20:R" & cellb.Row - 1), Range("T20:U" & cellb.Row - 1), Range("X20:Y" & cellb.Row - 1), Range("AA20:AB" & cellb.Row - 1), Range("AE20:AF" & cellb.Row - 1), Range("AH20:AI" & cellb.Row - 1), Range("AL20:AM" & cellb.Row - 1), Range("AO20:AP" & cellb.Row - 1), Range("AS20:AT" & cellb.Row - 1), Range("AV20:AW" & cellb.Row - 1), Range("AZ20:BA" & cellb.Row - 1), Range("BC20:BD" & cellb.Row - 1), Range("BG20:BH" & cellb.Row - 1), Range("BJ20:BK" & cellb.Row - 1), Range("BN20:BO" & cellb.Row - 1), Range("BQ20:BR" & cellb.Row - 1), Range("BU20:BV" & cellb.Row - 1), Range("BX20:BY" & cellb.Row - 1), Range("CB20:CC" & cellb.Row - 1), Range("CE20:CF" & cellb.Row - 1)) ' 26 ranges with unknown # of cells
        Set InputRange5 = Union(InputRange, InputRange1, InputRange2, InputRange3, InputRange4)
        OldWbk.Activate
        Set InputRange6 = Union(Range("C3"), Range("C4"), Range("C6"), Range("C7"), Range("C9"), Range("E6"), Range("E7"), Range("E9"), Range("J3"), Range("J4"), Range("J6"), Range("J7"), Range("J9"), Range("L6"), Range("L7"), Range("L9"), Range("Q3"), Range("Q4"), Range("Q6"), Range("Q7"), Range("Q9"), Range("S6"), Range("S7"), Range("S9"), Range("X3"), Range("X4"), Range("X6"), Range("X7"), Range("X9"), Range("Z6")) '30 ranges
        Set InputRange7 = Union(Range("Z7"), Range("Z9"), Range("AE3"), Range("AE4"), Range("AE6"), Range("AE7"), Range("AE9"), Range("AG6"), Range("AG7"), Range("AG9"), Range("AL3"), Range("AL4"), Range("AL6"), Range("AL7"), Range("AL9"), Range("AN6"), Range("AN7"), Range("AN9"), Range("AS3"), Range("AS4"), Range("AS6"), Range("AS7"), Range("AS9"), Range("AU6"), Range("AU7"), Range("AU9"), Range("AZ3"), Range("AZ4")) '28 ranges
        Set InputRange8 = Union(Range("AZ6"), Range("AZ7"), Range("AZ9"), Range("BB6"), Range("BB7"), Range("BB9"), Range("BG3"), Range("BG4"), Range("BG6"), Range("BG7"), Range("BG9"), Range("BI6"), Range("BI7"), Range("BI9"), Range("BN3"), Range("BN4"), Range("BN6"), Range("BN7"), Range("BN9"), Range("BP6"), Range("BP7"), Range("BP9"), Range("BU3"), Range("BU4"), Range("BU6"), Range("BU7"), Range("BU9"), Range("BW6")) '28 ranges
        Set InputRange9 = Union(Range("BW7"), Range("BW9"), Range("CB3"), Range("CB4"), Range("CB6"), Range("CB7"), Range("CB9"), Range("CD6")) '8 ranges
        Set InputRange10 = Union(Range("CD7"), Range("CD9"), Range("C20:D" & cellb.Row - 1), Range("F20:G" & cellb.Row - 1), Range("J20:K" & cellb.Row - 1), Range("M20:N" & cellb.Row - 1), Range("Q20:R" & cellb.Row - 1), Range("T20:U" & cellb.Row - 1), Range("X20:Y" & cellb.Row - 1), Range("AA20:AB" & cellb.Row - 1), Range("AE20:AF" & cellb.Row - 1), Range("AH20:AI" & cellb.Row - 1), Range("AL20:AM" & cellb.Row - 1), Range("AO20:AP" & cellb.Row - 1), Range("AS20:AT" & cellb.Row - 1), Range("AV20:AW" & cellb.Row - 1), Range("AZ20:BA" & cellb.Row - 1), Range("BC20:BD" & cellb.Row - 1), Range("BG20:BH" & cellb.Row - 1), Range("BJ20:BK" & cellb.Row - 1), Range("BN20:BO" & cellb.Row - 1), Range("BQ20:BR" & cellb.Row - 1), Range("BU20:BV" & cellb.Row - 1), Range("BX20:BY" & cellb.Row - 1), Range("CB20:CC" & cellb.Row - 1), Range("CE20:CF" & cellb.Row - 1)) ' 26 ranges with unknown # of cells
        Set InputRange11 = Union(InputRange6, InputRange7, InputRange8, InputRange9, InputRange10)
        InputRange11.Select
        Selection.Copy
        NewWbk.Activate
        InputRange5.Select
        Selection.PasteSpecial xlPasteValues
    Else
    End If
ElseIf Answer1 = vbYes Then
    Set LstYr = OldWbk.Worksheets(WshName2).Range("F" & cellb.Row, "G" & cellb.Row, "M" & cellb.Row, "N" & cellb.Row, "T" & cellb.Row, "U" & cellb.Row, "AA" & cellb.Row, "AB" & cellb.Row, "AH" & cellb.Row, "AI" & cellb.Row, "AO" & cellb.Row, "AP" & cellb.Row, "AV" & cellb.Row, "AW" & cellb.Row, "BC" & cellb.Row, "BD" & cellb.Row, "BJ" & cellb.Row, "BK" & cellb.Row, "BQ" & cellb.Row, "BR" & cellb.Row, "BX" & cellb.Row, "BY" & cellb.Row, "CE" & cellb.Row, "CF" & cellb.Row)  '24 ranges
    Set ThisYr = NewWbk.Worksheets(WshName).Range("C3, C4, J3, J4, Q3, Q4, X3, X4, AE3, AE4, AL3, AL4, AS3, AS4, AZ3, AZ4, BG3, BG4, BN3, BN4, BU3, BU4, CB3, CB4") '24 ranges
    OldWbk.Activate
    OldWbk.Worksheets(WshName2).Range("F" & cellb.Row).Select

    For MyCell1 = 1 To 24
        SumArray1(MyCell1) = 0
    Next MyCell1
    MyCell1 = 1

    For Each cell In LstYr
        SumArray1(MyCell1) = cell.Value
        MyCell1 = MyCell1 = 1
    Next cell

    NewWbk.Activate
    MyCell1 = 1
    For Each cell In ThisYr
        cell.Value = SumArray1(MyCell1)
        MyCell1 = MyCell1 = 1
    Next cell
End If
OldWbk.Close SaveChanges:=False
NewWbk.Protect

Application.ScreenUpdating = True

ErrorHandler:
    Resume Next

End Sub

[flickr 上的截图]http://www.flickr.com/photos/32470349@N03/11873809585/

【问题讨论】：

一种方法可能是通过：InputRange5.Count 获取条目数，并像使用“最后一行”进行计数一样使用它。
抱歉不了解 Portland Runner...我该如何使用它？
您是否将其粘贴到新工作簿中完全相同的区域？我的意思是旧的C3 要复制到新的C3 中？和完全相同的范围大小？只是不同的工作簿？
你好 L42。是的，没有。每次宏运行时，“联合”部分中的范围大小将是不同的行数，但列将是相同的。

标签： excel vba

【解决方案1】：

L42 提供的答案不适用于我的情况，对于类似于他想象的情况，绝对是一个可行的解决方案。

我的最终工作代码如下所示。以ElseIf Answer1 = vbYes Then 开头的“InputRange”联合系列下方的部分是我解决发布的非连续问题的方法。

Option Explicit
Sub UpdateFromOld()

    Dim fd As FileDialog
    Dim NewWbk As Workbook, OldWbk As Workbook
    Dim vrtSelectedItem As Variant, fname As Variant
    Dim cella As Range, cellb As Range, cell1 As Range, cell2 As Range
    Dim cell As Range, PasteRng As Range
    Dim wsh As Worksheet, wsh2 As Worksheet
    Dim WshName As String, WshName2 As String, MyDate As String
    Dim Answer1 As String, Answer2 As String
    Dim UsedRange1 As Range, UsedRange2 As Range
    Dim InputRange As Range, InputRange1 As Range, InputRange2 As Range, InputRange3 As Range, InputRange4 As Range, InputRange5 As Range
    Dim InputRange6 As Range, InputRange7 As Range, InputRange8 As Range, InputRange9 As Range, InputRange10 As Range, InputRange11 As Range
    Dim LstYr1 As Range, LstYr2 As Range, ThisYr1 As Range, ThisYr2 As Range
    Dim ExtraRows As Integer, RowCounter As Integer
    Dim SumArray1(12)
    Dim MyCell1

    On Error GoTo ErrorHandler

    Range("B5").Select
    WshName = InputBox("Type in your location name", "Annual Ad Planner")
    MyDate = InputBox("Enter the year you are working on in YYYY format.", "Annual Ad Planner")
    Set NewWbk = ThisWorkbook
    NewWbk.Unprotect
    ActiveSheet.Unprotect
    Range("A6").Value = "1/10/" & MyDate
    Range("B5").Value = WshName
    ActiveSheet.Name = WshName
    Set wsh = NewWbk.Worksheets(WshName)

    'Application.ScreenUpdating = False

    'select the old file to update from
    MsgBox "In the next window, navigate to and select the Ad Planner file you are updating from.", vbOKOnly, "Annual Ad Planner"
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Add "Previous Ad Planner", "*.xls", 1
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                fname = vrtSelectedItem
            Next vrtSelectedItem
        Else
            MsgBox "You ended the update process.", vbOKOnly, "Annual Ad Planner"
            GoTo ErrorHandler
        End If
    End With

    Set OldWbk = Workbooks.Open(fname)
    OldWbk.Unprotect
    Set fd = Nothing


    NewWbk.Worksheets(WshName).Visible = True
    NewWbk.Worksheets(WshName).Activate
    NewWbk.Worksheets(WshName).Unprotect
    Set cella = Cells(Rows.Count, "A").End(xlUp).Offset(0, 0)
    Range("A" & cella.Row).Select

    OldWbk.Activate
    Range("B5").Select
    WshName2 = ActiveCell.Worksheet.Name
    Set wsh2 = Worksheets(WshName2)
    OldWbk.Worksheets(WshName2).Visible = True
    OldWbk.Worksheets(WshName2).Activate
    OldWbk.Worksheets(WshName2).Unprotect
    Set cellb = Cells(Rows.Count, "A").End(xlUp).Offset(0, 0)
    Range("A" & cellb.Row).Select

    Range("B5").Select
    Selection.Copy
    NewWbk.Activate
    Range("B5").Select
    Range("B5").PasteSpecial xlPasteValues

    Range("B23").Select
    If cellb.Row > cella Then
        ExtraRows = cellb.Row - cella
        For RowCounter = 1 To ExtraRows
            AddRow
        Next RowCounter
    End If
    NewWbk.Unprotect
    NewWbk.Worksheets(WshName).Unprotect

    'Copy & Paste list of lead sources
    OldWbk.Activate
    Range("B20:B" & cellb.Row - 1).Select
    Selection.Copy
    NewWbk.Activate
    Range("B20").Select
    Range("B20").PasteSpecial xlPasteValues

    'Copy & Paste classifications & segments
    OldWbk.Activate
    Range("CI20:CK" & cellb.Row - 1).Select
    Selection.Copy
    NewWbk.Activate
    Range("CI20").Select
    Range("CI20").PasteSpecial xlPasteValues
    Application.CutCopyMode = False

    Answer1 = MsgBox("Are you importing sources and totals from last year's file?", vbYesNoCancel, "Annual Ad Planner")
    If Answer1 = vbNo Then
        Answer2 = MsgBox("Are you updating the current file to the new format?", vbYesNoCancel, "Annual Ad Planner")
        If Answer2 = vbYes Then
            Set InputRange = Union(Range("C3"), Range("C4"), Range("C6"), Range("C7"), Range("C9"), Range("E6"), Range("E7"), Range("E9"), Range("J3"), Range("J4"), Range("J6"), Range("J7"), Range("J9"), Range("L6"), Range("L7"), Range("L9"), Range("Q3"), Range("Q4"), Range("Q6"), Range("Q7"), Range("Q9"), Range("S6"), Range("S7"), Range("S9"), Range("X3"), Range("X4"), Range("X6"), Range("X7"), Range("X9"), Range("Z6")) '30 ranges
            Set InputRange1 = Union(Range("Z7"), Range("Z9"), Range("AE3"), Range("AE4"), Range("AE6"), Range("AE7"), Range("AE9"), Range("AG6"), Range("AG7"), Range("AG9"), Range("AL3"), Range("AL4"), Range("AL6"), Range("AL7"), Range("AL9"), Range("AN6"), Range("AN7"), Range("AN9"), Range("AS3"), Range("AS4"), Range("AS6"), Range("AS7"), Range("AS9"), Range("AU6"), Range("AU7"), Range("AU9"), Range("AZ3"), Range("AZ4")) '28 ranges
            Set InputRange2 = Union(Range("AZ6"), Range("AZ7"), Range("AZ9"), Range("BB6"), Range("BB7"), Range("BB9"), Range("BG3"), Range("BG4"), Range("BG6"), Range("BG7"), Range("BG9"), Range("BI6"), Range("BI7"), Range("BI9"), Range("BN3"), Range("BN4"), Range("BN6"), Range("BN7"), Range("BN9"), Range("BP6"), Range("BP7"), Range("BP9"), Range("BU3"), Range("BU4"), Range("BU6"), Range("BU7"), Range("BU9"), Range("BW6")) '28 ranges
            Set InputRange3 = Union(Range("BW7"), Range("BW9"), Range("CB3"), Range("CB4"), Range("CB6"), Range("CB7"), Range("CB9"), Range("CD6")) '8 ranges
            Set InputRange4 = Union(Range("CD7"), Range("CD9"), Range("C20:D" & cellb.Row - 1), Range("F20:G" & cellb.Row - 1), Range("J20:K" & cellb.Row - 1), Range("M20:N" & cellb.Row - 1), Range("Q20:R" & cellb.Row - 1), Range("T20:U" & cellb.Row - 1), Range("X20:Y" & cellb.Row - 1), Range("AA20:AB" & cellb.Row - 1), Range("AE20:AF" & cellb.Row - 1), Range("AH20:AI" & cellb.Row - 1), Range("AL20:AM" & cellb.Row - 1), Range("AO20:AP" & cellb.Row - 1), Range("AS20:AT" & cellb.Row - 1), Range("AV20:AW" & cellb.Row - 1), Range("AZ20:BA" & cellb.Row - 1), Range("BC20:BD" & cellb.Row - 1), Range("BG20:BH" & cellb.Row - 1), Range("BJ20:BK" & cellb.Row - 1), Range("BN20:BO" & cellb.Row - 1), Range("BQ20:BR" & cellb.Row - 1), Range("BU20:BV" & cellb.Row - 1), Range("BX20:BY" & cellb.Row - 1), Range("CB20:CC" & cellb.Row - 1), Range("CE20:CF" & cellb.Row - 1)) ' 26 ranges with unknown # of cells
            Set InputRange5 = Union(InputRange, InputRange1, InputRange2, InputRange3, InputRange4)
            OldWbk.Activate
            Set InputRange6 = Union(Range("C3"), Range("C4"), Range("C6"), Range("C7"), Range("C9"), Range("E6"), Range("E7"), Range("E9"), Range("J3"), Range("J4"), Range("J6"), Range("J7"), Range("J9"), Range("L6"), Range("L7"), Range("L9"), Range("Q3"), Range("Q4"), Range("Q6"), Range("Q7"), Range("Q9"), Range("S6"), Range("S7"), Range("S9"), Range("X3"), Range("X4"), Range("X6"), Range("X7"), Range("X9"), Range("Z6")) '30 ranges
            Set InputRange7 = Union(Range("Z7"), Range("Z9"), Range("AE3"), Range("AE4"), Range("AE6"), Range("AE7"), Range("AE9"), Range("AG6"), Range("AG7"), Range("AG9"), Range("AL3"), Range("AL4"), Range("AL6"), Range("AL7"), Range("AL9"), Range("AN6"), Range("AN7"), Range("AN9"), Range("AS3"), Range("AS4"), Range("AS6"), Range("AS7"), Range("AS9"), Range("AU6"), Range("AU7"), Range("AU9"), Range("AZ3"), Range("AZ4")) '28 ranges
            Set InputRange8 = Union(Range("AZ6"), Range("AZ7"), Range("AZ9"), Range("BB6"), Range("BB7"), Range("BB9"), Range("BG3"), Range("BG4"), Range("BG6"), Range("BG7"), Range("BG9"), Range("BI6"), Range("BI7"), Range("BI9"), Range("BN3"), Range("BN4"), Range("BN6"), Range("BN7"), Range("BN9"), Range("BP6"), Range("BP7"), Range("BP9"), Range("BU3"), Range("BU4"), Range("BU6"), Range("BU7"), Range("BU9"), Range("BW6")) '28 ranges
            Set InputRange9 = Union(Range("BW7"), Range("BW9"), Range("CB3"), Range("CB4"), Range("CB6"), Range("CB7"), Range("CB9"), Range("CD6")) '8 ranges
            Set InputRange10 = Union(Range("CD7"), Range("CD9"), Range("C20:D" & cellb.Row - 1), Range("F20:G" & cellb.Row - 1), Range("J20:K" & cellb.Row - 1), Range("M20:N" & cellb.Row - 1), Range("Q20:R" & cellb.Row - 1), Range("T20:U" & cellb.Row - 1), Range("X20:Y" & cellb.Row - 1), Range("AA20:AB" & cellb.Row - 1), Range("AE20:AF" & cellb.Row - 1), Range("AH20:AI" & cellb.Row - 1), Range("AL20:AM" & cellb.Row - 1), Range("AO20:AP" & cellb.Row - 1), Range("AS20:AT" & cellb.Row - 1), Range("AV20:AW" & cellb.Row - 1), Range("AZ20:BA" & cellb.Row - 1), Range("BC20:BD" & cellb.Row - 1), Range("BG20:BH" & cellb.Row - 1), Range("BJ20:BK" & cellb.Row - 1), Range("BN20:BO" & cellb.Row - 1), Range("BQ20:BR" & cellb.Row - 1), Range("BU20:BV" & cellb.Row - 1), Range("BX20:BY" & cellb.Row - 1), Range("CB20:CC" & cellb.Row - 1), Range("CE20:CF" & cellb.Row - 1)) ' 26 ranges with unknown # of cells
            Set InputRange11 = Union(InputRange6, InputRange7, InputRange8, InputRange9, InputRange10)
            InputRange11.Select
            For Each cell In InputRange11
                OldWbk.Activate
                InputRange5.Range(cell.Address).Offset(-2, -2).Value = InputRange11.Range(cell.Address).Offset(-2, -2).Value
            Next
            NewWbk.Activate
            Range("B5").Value = WshName
        Else
        End If
    ElseIf Answer1 = vbYes Then
        OldWbk.Activate
        Set LstYr1 = Union(Range("F" & cellb.Row - 10), Range("M" & cellb.Row - 10), Range("T" & cellb.Row - 10), Range("AA" & cellb.Row - 10), Range("AH" & cellb.Row - 10), Range("AO" & cellb.Row - 10), Range("AV" & cellb.Row - 10), Range("BC" & cellb.Row - 10), Range("BJ" & cellb.Row - 10), Range("BQ" & cellb.Row - 10), Range("BX" & cellb.Row - 10), Range("CE" & cellb.Row - 10))  '12 ranges
        Set LstYr2 = Union(Range("G" & cellb.Row - 10), Range("N" & cellb.Row - 10), Range("U" & cellb.Row - 10), Range("AB" & cellb.Row - 10), Range("AI" & cellb.Row - 10), Range("AP" & cellb.Row - 10), Range("AW" & cellb.Row - 10), Range("BD" & cellb.Row - 10), Range("BK" & cellb.Row - 10), Range("BR" & cellb.Row - 10), Range("BY" & cellb.Row - 10), Range("CF" & cellb.Row - 10))  '12 ranges
        NewWbk.Activate
        Set ThisYr1 = Union(Range("C3"), Range("J3"), Range("Q3"), Range("X3"), Range("AE3"), Range("AL3"), Range("AS3"), Range("AZ3"), Range("BG3"), Range("BN3"), Range("BU3"), Range("CB3")) '24 ranges
        Set ThisYr2 = Union(Range("C4"), Range("J4"), Range("Q4"), Range("X4"), Range("AE4"), Range("AL4"), Range("AS4"), Range("AZ4"), Range("BG4"), Range("BN4"), Range("BU4"), Range("CB4")) '24 ranges

        For MyCell1 = 1 To 12
            SumArray1(MyCell1) = 0
        Next MyCell1
        MyCell1 = 1

        OldWbk.Activate
        For Each cell In LstYr1
            Range(cell.Address).Select
            SumArray1(MyCell1) = cell.Value
            MyCell1 = MyCell1 + 1
        Next cell

        MyCell1 = 1
        NewWbk.Activate
        For Each cell2 In ThisYr2
            Range(cell2.Address).Select
            cell2.Value = SumArray1(MyCell1)
            MyCell1 = MyCell1 + 1
        Next cell2

        For MyCell1 = 1 To 12
            SumArray1(MyCell1) = 0
        Next MyCell1
        MyCell1 = 1

        OldWbk.Activate
        For Each cell In LstYr2
            Range(cell.Address).Select
            SumArray1(MyCell1) = cell.Value
            MyCell1 = MyCell1 + 1
        Next cell

        MyCell1 = 1
        NewWbk.Activate
        For Each cell2 In ThisYr1
            Range(cell2.Address).Select
            cell2.Value = SumArray1(MyCell1)
            MyCell1 = MyCell1 + 1
        Next cell2

        NewWbk.Activate
        Range("B5").Value = WshName

    End If
    OldWbk.Close SaveChanges:=False
    NewWbk.Protect
    ActiveSheet.Protect
    Range("C3").Select

    Application.ScreenUpdating = True

ErrorHandler:
        Resume Next

End Sub

【讨论】：

【解决方案2】：

在检查您的代码后，我发现您确实将整个选择从Old Wb 复制并粘贴到New Wb 的地址完全相同，对吗？
我不会直接回答你的问题，但如果上述说法属实，你可以使用这种方法：

假设你有这样的数据作为你的来源：

并且您想将数据粘贴到具有此数据的另一个工作簿中：

那么你可以使用这种方法：

Sub test()

Dim copyRng As Range, cel As Range, _
    pasteRng As Range

Set copyRng = ThisWorkbook.Sheets("Sheet1").Range("B2,B4,C3,D5:E5")
Set pasteRng = ThisWorkbook.Sheets("Sheet2").Range("A1")

For Each cel In copyRng
    cel.Copy
    pasteRng.Range(cel.Address).PasteSpecial xlPasteValues
Next
Application.CutCopyMode = False
End Sub

结果会是这样的：

希望这能让你开始你想要完成的事情。
而且我认为您根本不需要使用Union。

【讨论】：

非常感谢您为构建示例所做的努力。我就是这样开始的。由于使用了可变行号，我遇到了问题。 Excel 喜欢用引号括起来的范围，比如你的 [Range("B2,B4,C3,D5:E5")]，但不是 [Range("B4", "C" & lastrow.row, " B6"、"D" 和 lastrow.row)]
此外，更复杂的是，值单元格之间的单元格中的公式不能被弄乱。