Excel VB代码复制工作簿中的多个区域，并粘贴到新工作簿中

Question

我正在寻找一个脚本，将复制数据的特定范围，跨多个工作表，然后将该数据粘贴到一个全新的工作簿。凭借我的基本知识，我可以在工作簿中为单个工作表做到这一点，但不是多个。

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

然后将这些单元格粘贴到一个新的工作簿中，在两个新的工作表Wkst a和b上。

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

有什么建议吗?

Answer 1

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

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