复制活动工作表中的非连续范围以选择工作表

时间:2018-08-09 18:51:59

标签: excel vba

我正在尝试:

  1. 复制活动工作表(TheRange)中的数字
  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

1 个答案:

答案 0 :(得分:0)

您在这里。让我知道是否有任何问题。

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