我的错误消息是“对象必需”'当我运行这个子。我有一个用于复制每个特定工作表的版本,工作正常,但是这个子工具适用于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
答案 0 :(得分:3)
尝试执行类似的操作(问题是您尝试使用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
答案 1 :(得分:1)
这对我有用(我添加了一个"如果工作表可见"因为在我的情况下我想跳过隐藏的工作表)
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
答案 2 :(得分:0)
重新思考你的方法。为什么你只复制表格的一部分?您指的是不存在的命名范围“WholePrintArea”。此外,您永远不应在脚本中使用激活,选择,复制或粘贴。这些使“脚本”容易受到用户操作和其他同时执行的影响。在最坏的情况下,情景数据最终落入坏人之手。