如何将非连续单元格从工作簿复制到另一个工作簿中不同的非连续单元格集合？

我有一个主空白工作簿，用户使用副本来logging1年的信息 – 他们的副本将是“旧”工作簿。 主空白目前允许用户指向去年的“旧”工作簿，在新的行中插入适当数量的行以匹配旧行中使用的行，然后将旧的两个不同连续范围复制/粘贴到匹配范围在“新”空白工作簿中。 迄今为止工作很好。 但是…现在，我希望它复制旧工作表中非连续列的总计值，并将它们粘贴到新工作表上不同的非连续单元格中。

总计总是在不同的行上为每个用户，所以我使用lastrow函数来查找行号。 但似乎我不能用它来定义不连续的范围

所以，我不知道你是否需要所有的代码，但它包含在下面。 你会注意到我试图从旧的工作表中获取所有数据的部分，并使用Union范围将其粘贴到新的工作表中，因为它也是一堆非连续的单元格，但它不适用于我。 我想如果我要解决第一个问题，那么我应该能够适应第二个问题，但如果你也帮助解决这个问题，我会很感激。

编辑：
我修改了“联合”部分，现在所有正确的单元格都被选中，但“selection.copy”失败。 有什么select？

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

预先感谢您的帮助。

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上托pipe截图] http://www.flickr.com/photos/32470349@N03/11873809585/

Answer 1

在检查你的代码后，我发现你真的是复制和粘贴从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 。

Answer 2

我终于解决了我的问题。 L42所提供的答案是接近的，但对我的情况不起作用，对于类似于他所想象的情况来说，这绝对是一个可行的解决办法，所以我想再次感谢他的投入。 我的最后工作代码如下所示。 以“ElseIf Answer1 = vbYes Then”开头的一系列“InputRange”工会下面的部分是我如何解决我发布的非连续问题。 如果有人有一个更简单的解决scheme，我会有兴趣看到它。

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：继续下一步

结束小组