這是一種選擇,你只需通過你的範圍到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
來源
2016-11-03 18:03:44
Joe
你嘗試過什麼?請搜索一下,特別是在SO上,因爲這個問題已經有很多不同的形式。請告訴我們你找到了什麼,有什麼/沒有工作,或者你有一些代碼的任何具體問題。 – BruceWayne
我目前正在使用: 工作表( 「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
(你能代替懇請您的OP編輯代碼,並使用代碼標籤('{}')格式化嗎?謝謝!) – BruceWayne