2016-11-03 99 views
-1

我期待的一個腳本,將複製數據的特定範圍內,在多個工作表,然後粘貼數據到一個全新的工作簿。憑藉我的基本知識,我可以在工作簿中爲單個工作表執行此操作,但不是多次。Excel的VB代碼複製多個範圍的工作簿,並在新工作簿粘貼

實施例,複製單元格A7:從WKST甲S1000,然後細胞A7:S1000從WKST B.

然後粘貼那些細胞在新的工作簿時,對兩個新的工作表WKST A和B.

我不希望保存新的工作簿,並且它必須是每次創建一個全新的工作簿。

有什麼建議嗎?

+0

你嘗試過什麼?請搜索一下,特別是在SO上,因爲這個問題已經有很多不同的形式。請告訴我們你找到了什麼,有什麼/沒有工作,或者你有一些代碼的任何具體問題。 – BruceWayne

+0

我目前正在使用: 工作表( 「SHEETNAME」)範圍。( 「A7:S1000」)複製 設置newWB = Workbooks.Add 隨着newWB 設置新聞= newWB.Sheets( 「工作表Sheet1」) 消息。範圍(「A3」)。PasteSpecial Paste:= xlPasteValues,Operation:= xlNone newS.Range(「A3」)。PasteSpecial Paste:= xlPasteFormats,Operation:= xlNone,_ SkipBlanks:= False,Transpose:= False 結束與 我試圖做複製一個數組,但不能得到一個向多個範圍工作。我也沒有發現任何沒有引用新的被保存的wb或事先引用的wb的東西。 – JonnySweatpants

+0

(你能代替懇請您的OP編輯代碼,並使用代碼標籤('{}')格式化嗎?謝謝!) – BruceWayne

回答

0

這是一種選擇,你只需通過你的範圍到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 
相關問題