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

时间：2014-01-10 01:34:30

标签： excel vba excel-vba

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

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

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

修改
我修改了“union”部分，现在正在选择所有正确的单元格，但“selection.copy”失败。有什么替代方案？

编辑＃2：
我添加了Master空白和用户文件的两个屏幕截图。很容易看出a）行数不同，b）阴影区域是我想复制/粘贴的区域（在代码的'union'部分）。在下一对屏幕截图中，用户文件的红色和绿色单元格需要导入到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/

2 个答案:

答案 0 :(得分：0)

检查完代码后，我发现您确实正在将整个选择从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。

答案 1 :(得分：0)

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

选项明确 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：         继续下一步

End Sub

相关问题
最新问题