如何將不連續的單元格從一個工作簿復制到另一個工作簿中的另一組不連續的單元格？
[英]How can I copy non-contiguous cells from a workbook to a different set of non-contiguous cells in another workbook?
問題描述
我有一個供用戶復制的Master空白工作簿，用於記錄一年的信息。 主空白允許用戶指向去年的“舊”工作簿，將適當的行數插入新行以匹配舊行，然后將舊行中的兩個不同的連續范圍復制/粘貼到“新行”中的匹配范圍中空白工作簿。
現在，我希望它可以將舊工作表中非連續列的總計值復制到新工作表中的不同非連續單元格中。
每個用戶的總數在不同的行上，因此我使用了lastrow函數來查找行號。 但是似乎我不能在定義非連續范圍時使用它。
所有代碼都包含在下面。 您會注意到一個部分，在該部分中，我試圖使用Union on range將所有數據從舊工作表復制到新工作表中，因為它也是一堆不連續的單元格，但是它們也不起作用。 如果我解決了第一個問題，則應該能夠使它適應第二個問題。
編輯：
我修改了“聯合”部分，現在選擇了所有正確的單元格，但是Selection.Copy失敗了。 有什么選擇？
編輯＃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上托管的屏幕截圖] http://www.flickr.com/photos/32470349@N03/11873809585/
2 個解決方案
解決方案1
1 2014-01-15 16:25:32
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
0 2014-01-10 05:39:23
經審查，你的代碼，我發現你真的是復制和粘貼從整個選擇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 。
如何將范圍中最近的非連續單元格復制到另一個工作表上的連續范圍中？
[英]How to copy most recent non-contiguous cells in a range into a contiguous range on another worksheet?
根據條件在不同的工作表中復制/粘貼從非連續列到非連續列的一系列數據
[英]copy/paste a range of data from non contiguous to non-contiguous columns in a different worksheet based on condition
聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.