Question

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

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

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

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

有什么建议吗？

Answer 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

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

1 个答案: