Excel VBA 代码复制工作簿中的多个范围，并粘贴到新工作簿中答案

【问题标题】：Excel VB Code to Copy Multiple Ranges in Workbook, and Paste in new WorkbookExcel VBA 代码复制工作簿中的多个范围，并粘贴到新工作簿中
【发布时间】：2016-11-04 03:33:35
【问题描述】：

我正在寻找一个脚本，它可以跨多个工作表复制特定范围的数据，然后将该数据粘贴到一个全新的工作簿中。以我的基本知识，我可以为工作簿中的单个工作表执行此操作，但不能为多个。

例如，从 Wkst A 复制单元格 A7:S1000，然后从 Wkst B 复制单元格 A7:S1000。

然后将这些单元格粘贴到新工作簿中的两个新工作表 Wkst A 和 B 上。

我不想保存新工作簿，它必须是每次创建的全新工作簿。

有什么建议吗？

【问题讨论】：

你试过什么？请四处搜索，尤其是在 SO 上，因为这个问题已经以许多不同的形式提出。请向我们展示您发现的内容和无效/无效的内容，或者您对某些代码的任何具体问题。
我目前正在使用：Worksheets("SheetName").Range ("A7:S1000").Copy Set newWB = Workbooks.Add With newWB Set newS = newWB.Sheets("Sheet1") newS .Range("A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone newS.Range("A3").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End With我试图为 Copy 做一个数组，但无法让它适用于多个范围。我也没有找到任何不引用正在保存的新 wb 或预先引用的 wb 的内容。
（您能否将该代码编辑到您的 OP 中并使用代码标签 ({}) 对其进行格式化？谢谢！）
我想要这个，除了多个工作表和多个范围，没有保存功能stackoverflow.com/a/35648489/7110600
您应该搜索“VBA 循环工作表”和“VBA 循环范围”。（PS：请将您的代码更新到OP中，在cmets中很难阅读。）

标签： excel macros vba

【解决方案1】：

这是一个选项，您只需将您的范围传递给 DuplicateToNewWB 过程：

Public Function WorksheetExists(wbSource As Workbook, strWorksheet As String) As Boolean

    Dim intIndex As Integer

    On Error GoTo eHandle
    intIndex = Worksheets(strWorksheet).Index
    WorksheetExists = True
    Exit Function
eHandle:
    WorksheetExists = False
End Function


Public Sub DuplicateToNewWB(rngSource As Range)

    Dim wbTarget As Workbook    'The new workbook
    Dim rngItem As Range        'Used to loop the passed source range
    Dim wsSource As Worksheet   'The source worksheet in existing workbook to read
    Dim wsTarget As Worksheet   'The worksheet in the new workbook to write

    Set wbTarget = Workbooks.Add
    For Each rngItem In rngSource

        'Assign the source worksheet to that of the current range being copied
        Set wsSource = rngItem.Parent

        'Assign the target worksheet
        If WorksheetExists(wbSource:=wbTarget, strWorksheet:=wsSource.Name) Then
            Set wsTarget = wbTarget.Worksheets(wsSource.Name)
        Else
            Set wsTarget = wbTarget.Worksheets.Add
            wsTarget.Name = wsSource.Name
        End If

        'Copy the value
        wsTarget.Range(rngItem.Address) = rngItem
    Next

    'Cleanup
    Set rngItem = Nothing
    Set wsSource = Nothing
    Set wsTarget = Nothing
    Set wbTarget = Nothing
End Sub

【讨论】：