![](/img/trans.png)
[英]Excel VBA Copying Sheets to a New Workbook and emailing the New Workbook in Outlook
[英]Excel VBA: Copying multiple sheets into new workbook
運行此子程序時,我收到“需要對象”的錯誤消息。 我有一個用於復制每個特定工作表的版本,效果很好,但是這個子程序適用於 WB 內的所有工作表,即復制每個人的 WholePrintArea 並將其粘貼到新 WB 中的新工作表中。 謝謝...
Sub NewWBandPasteSpecialALLSheets()
MyBook = ActiveWorkbook.Name ' Get name of this book
Workbooks.Add ' Open a new workbook
NewBook = ActiveWorkbook.Name ' Save name of new book
Workbooks(MyBook).Activate ' Back to original book
Dim SH As Worksheet
For Each SH In MyBook.Worksheets
SH.Range("WholePrintArea").Copy
Workbooks(NewBook).Activate
With SH.Range("A1")
.PasteSpecial (xlPasteColumnWidths)
.PasteSpecial (xlFormats)
.PasteSpecial (xlValues)
End With
Next
End Sub
嘗試做這樣的事情(問題是您嘗試使用MyBook.Worksheets
,但MyBook
不是Workbook
對象,而是包含工作簿名稱的string
。我添加了新變量Set WB = ActiveWorkbook
,因此您可以使用WB.Worksheets
代替MyBook.Worksheets
):
Sub NewWBandPasteSpecialALLSheets()
MyBook = ActiveWorkbook.Name ' Get name of this book
Workbooks.Add ' Open a new workbook
NewBook = ActiveWorkbook.Name ' Save name of new book
Workbooks(MyBook).Activate ' Back to original book
Set WB = ActiveWorkbook
Dim SH As Worksheet
For Each SH In WB.Worksheets
SH.Range("WholePrintArea").Copy
Workbooks(NewBook).Activate
With SH.Range("A1")
.PasteSpecial (xlPasteColumnWidths)
.PasteSpecial (xlFormats)
.PasteSpecial (xlValues)
End With
Next
End Sub
但是您的代碼沒有做您想做的事:它不會將某些內容復制到新的 WB。 所以,下面的代碼為你做:
Sub NewWBandPasteSpecialALLSheets()
Dim wb As Workbook
Dim wbNew As Workbook
Dim sh As Worksheet
Dim shNew As Worksheet
Set wb = ThisWorkbook
Workbooks.Add ' Open a new workbook
Set wbNew = ActiveWorkbook
On Error Resume Next
For Each sh In wb.Worksheets
sh.Range("WholePrintArea").Copy
'add new sheet into new workbook with the same name
With wbNew.Worksheets
Set shNew = Nothing
Set shNew = .Item(sh.Name)
If shNew Is Nothing Then
.Add After:=.Item(.Count)
.Item(.Count).Name = sh.Name
Set shNew = .Item(.Count)
End If
End With
With shNew.Range("A1")
.PasteSpecial (xlPasteColumnWidths)
.PasteSpecial (xlFormats)
.PasteSpecial (xlValues)
End With
Next
End Sub
重新考慮你的方法。 為什么只復制表格的一部分? 您指的是一個不存在的命名范圍“WholePrintArea”。 你也不應該在你的腳本中使用激活、選擇、復制或粘貼。 這些使“腳本”容易受到用戶操作和其他同時執行的影響。 在最壞的情況下,數據最終會落入壞人手中。
這對我有用(我添加了一個“如果工作表可見”,因為在我的情況下我想跳過隱藏的工作表)
Sub Create_new_file()
Application.DisplayAlerts = False
Dim wb As Workbook
Dim wbNew As Workbook
Dim sh As Worksheet
Dim shNew As Worksheet
Dim pname, parea As String
Set wb = ThisWorkbook
Workbooks.Add
Set wbNew = ActiveWorkbook
For Each sh In wb.Worksheets
pname = sh.Name
If sh.Visible = True Then
sh.Copy After:=wbNew.Sheets(Sheets.Count)
wbNew.Sheets(Sheets.Count).Cells.ClearContents
wbNew.Sheets(Sheets.Count).Cells.ClearFormats
wb.Sheets(sh.Name).Activate
Range(sh.PageSetup.PrintArea).Select
Selection.Copy
wbNew.Sheets(pname).Activate
Range("A1").Select
With Selection
.PasteSpecial (xlValues)
.PasteSpecial (xlFormats)
.PasteSpecial (xlPasteColumnWidths)
End With
ActiveSheet.Name = pname
End If
Next
wbNew.Sheets("Hoja1").Delete
Application.DisplayAlerts = True
End Sub
由於您要復制所有工作表,如何:
復制和粘貼 (X) SaveAS (O)
Sub Export()
Application.DisplayAlerts = False
On Error Resume Next
Dim NewWB As String
NewWB = Sheets("Control").Range("B42")
ActiveWorkbook.SaveAs Filename:=NewWB, FileFormat:=xlWorkbookNormal
ActiveWorkbook.Sheets("Control").Delete
End Sub
我有一個處理所有變體的工作表“控制”,您可以自己更改它
另一方面,如果你真的想使用 COPY & PASTE,你可以使用 ARRAY
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=FolderPath & ExcelName & ".xlsx", FileFormat:=xlNormal
Workbooks(ExcelOrigin).Activate
Sheets(Array("for coversheet", "Pivot", "CCA", "FRR", "CRS", "GSA", "Inv Summary", "UploadtoJDE", "Comat")).Copy Before:=Workbooks(ExcelName).Sheets(1)
Sheets("Sheet1").Delete
請記住將Dim (FolderPath,ExcelName,ExcelOrigin) as String
它們與您的文件名和文件路徑相同[由於錯誤,我無法在此處輸入]
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.