复制活动工作表中的不连续区域以选择工作表

Question

我正在尝试：

1. 复制活动工作表中的数字(范围(
有选择地
2. 定位某些工作表以粘贴选择范围

Sub ProjectMonth()
If MsgBox("This will project values in this month to all others! Are you sure?", vbYesNo) = vbNo Then Exit Sub
TheRange = "H3:H5,H9:H11,C6:D18,C22:D31,C35:D40,C44:D48,C52:D62,C66:D71,C75:D80,H20:I27,H31:I39,H43:I48,H52:I60,H64:I70,H75:I79"
Dim Sh As Worksheet
ActiveSheet.Range(TheRange).Select
ActiveSheet.Range(TheRange).Copy
For Each Sh In Sheets(Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"))
With Sh.Range(TheRange)
Selection.Paste
End With
Next
MsgBox ("Sequence Complete!")
End Sub

Answer 1

你去吧。如果有任何问题，请告诉我。

Sub PasteRanges()
If MsgBox("This will project values in this month to all others! Are you sure?", vbYesNo) = vbNo Then Exit Sub
Dim ranges As Variant, i As Integer, mainSheet As String, wb As Workbook
Set wb = ThisWorkbook
mainSheet = "CopyFromSheet"
ranges = Array("AH3:H5", "H9:H11", "C6:D18", "C22:D31", "C35:D40", "C44:D48", "C52:D62", "C66:D71", "C75:D80", "H20:I27", "H31:I39", "H43:I48", "H52:I60", "H64:I70", "H75:I79")
For Each Sh In wb.Sheets(Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"))
With Sh
For i = 0 To UBound(ranges)
wb.Sheets(mainSheet).Range(ranges(i)).Copy
Sh.Range(ranges(i)).PasteSpecial xlValues
Next i
End With
Next
Application.CutCopyMode = False
End Sub