如何將非連續單元格從工作簿複製到另一個工作簿中不同的非連續單元格集合？

我有一個主空白工作簿，用戶使用副本記錄1年的信息 - 他們的副本將是「舊」工作簿。主空白目前允許用戶指向去年的「舊」工作簿，在新的行中插入適當數量的行以匹配舊行中使用的行，然後將舊的兩個不同連續範圍複製/粘貼到匹配範圍在「新」空白工作簿中。迄今爲止效果很好。但是...現在，我希望它複製舊工作表上非連續列的總計值，並將它們粘貼到新工作表上的不同非連續單元格中。如何將非連續單元格從工作簿複製到另一個工作簿中不同的非連續單元格集合？

總計總是在不同的行上爲每個用戶，所以我使用lastrow函數來查找行號。但似乎我不能用它來定義非連續範圍或其他東西...

所以，我不知道你是否需要所有的代碼，但它包含在下面。你會注意到我試圖從舊工作表中獲取所有數據並使用Union範圍將其粘貼到新工作表中，因爲它也是一堆不連續的單元格，但它對我來說也不工作。我想如果我要解決第一個問題，那麼我應該能夠適應第二個問題，但如果你也幫助解決這個問題，我會很感激。

編輯：
我已經修改了「聯盟」部分，現在所有的正確的細胞被選中，但「selection.copy」失敗。有什麼選擇？

編輯＃2：
我已經添加了主空白和用戶文件的兩個屏幕截圖。很容易看出a）行數不同，b）陰影區域是我希望複製/粘貼的區域（在'union'代碼部分）。在下一對屏幕截圖中，需要將用戶文件的紅色和綠色單元格導入到主空白文件的相應紅色和綠色單元格中。希望這有助於解釋我的問題。

非常感謝您的幫助。

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/[email protected]/11873809585/

來源

2014-01-10 user3179945

一種方法可以得到的條目的數量通過計數：'InputRange5.Count'和像使用「最後一行」進行計數一樣使用它。 –

對不起，不瞭解波特蘭亞軍......我會如何使用它？ – user3179945

是否將它粘貼到新工作簿的完全相同區域中？我的意思是'C3'舊被複制到'C3'新的？和完全相同的範圍大小？只是不同的工作簿？ – L42

經審查，你的代碼，我發現你真的是複製和粘貼從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。

來源

2014-01-10 05:39:23 L42

非常感謝您爲構建示例所作的努力。我就是這樣開始的。由於使用了變量行號，我遇到了一個問題。 Excel喜歡用引號括起來的範圍[範圍（「B2，B4，C3，D5：E5」）]，但不是當它是[範圍（「B4」，「C」和lastrow.row「 B6「，」D「和lastrow.row）] – user3179945

此外，只是爲了更復雜的事情，有價值單元格之間有不能混淆公式的單元格。 – user3179945

我終於找到了我的問題。 L42提供的答案很接近，但對我的情況不起作用，對於類似於他想象的情況，這絕對是一個可行的解決方案，所以我想再次感謝他的投入。我的最終工作代碼如下所示。以「ElseIf Answer1 = vbYes Then」開頭的一系列「InputRange」工會下面的部分是我如何解決我發佈的非連續問題。如果任何人有一個更簡單的解決方案，我會有興趣看到它。

Explicit選項子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：繼續下一步

結束子

來源

2014-01-15 16:25:32 user3179945

如何將非連續單元格從工作簿複製到另一個工作簿中不同的非連續單元格集合？

回答

相關問題