I have the following code courtesy of get.digital.help.com
Code executes fine except for 2 things:
the personal.xlsb file pastes into new master wrkbk along with all the other open wrkbks.
How can code prevent personal.xlsb from being copied.
error code "Run time error 9: Subscript is out of range" generated at this line located just before "end macro"/ "end sub":
WBN.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
What is causing this error and how to fix it?
'Name macro
'https://www.get-digital-help.com/copy-each-sheet-in-active-workbook-to-new-workbooks/#master
Sub CopySheetsToMasterWorkbook()
'this version includes option to name copied worksheets
'Dimension variables and declare data types
Dim WBN As Workbook, WB As Workbook
Dim SHT As Worksheet
'Create a new workbook and save an object reference to variable WBN
Set WBN = Workbooks.Add
'Iterate through all open workbooks
For Each WB In Application.Workbooks
'Check if workbook name of object variable WB is not equal to name of object variable WBN
If WB.Name <> WBN.Name Then
'Go through all worksheets in object WB
For Each SHT In WB.Worksheets
'Copy worksheet to workbook WBN and place after the last worksheet
SHT.Copy After:=WBN.Sheets(WBN.Worksheets.Count)
'Adds option to name each WrkSht added to MasterWB
WBN.Sheets(WBN.Worksheets.Count).Name = Left(WB.Name, 30 - Len(SHT.Name)) & "-" & SHT.Name
'Continue with next worksheet
Next SHT
'End of If statement
End If
'Continue with next workbook
Next WB
'Disable Alerts
Application.DisplayAlerts = False
**'Delete sheet1, sheet2 and sheet3 in the new workbook WBN
WBN.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete**
'Enable Alerts
WBN.Application.DisplayAlerts = True
'End macro
End Sub
No comments:
Post a Comment