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

Question

我期待的一个脚本，将复制数据的特定范围内，在多个工作表，然后粘贴数据到一个全新的工作簿。凭借我的基本知识，我可以在工作簿中为单个工作表执行此操作，但不是多次。

实施例，复制单元格A7：从WKST甲S1000，然后细胞A7：S1000从WKST B.

然后粘贴那些细胞在新的工作簿时，对两个新的工作表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