ExcelBanter - How to write the code for copying 2 or more sheets to a new workbook at the same time?

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - How to write the code for copying 2 or more sheets to a new workbook at the same time? (https://www.excelbanter.com/excel-programming/356597-how-write-code-copying-2-more-sheets-new-workbook-same-time.html)

How to write the code for copying 2 or more sheets to a new workbook at the same time?

worksheets(Array("Sheet1","Sheet4")).Copy
Activeworkbook.SaveAs "C:\My Folder\abc.xls"
--
Regards,
Tom Ogilvy

"new.microsoft.com" wrote in message
...
As subject, Thanks

How to write the code for copying 2 or more sheets to a new workbook at the same time?

Hi, Tom
I don't know why the following code cannot work and with the error msg
(Run-time error '9' Subscript out of range), can you help?

For j = 5 To 99
dept_code = Right("0" & j, 2)
For i = 1 To Worksheets.Count

If Left(Worksheets(i).Name, 2) = dept_code Then
temp_array = temp_array & Chr(34) & Worksheets(i).Name & Chr(34) & ",
"
End If
Next i
temp_array = Left(temp_array, Len(temp_array) - 2)

If temp_array < "" Then
Sheets(Array(temp_array)).Copy
ActiveWorkbook.SaveAs Filename:= _
"C:\testing.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False,
_
CreateBackup:=False
ActiveWindow.Close
End If
temp_array = ""

Next j

"Tom Ogilvy" wrote in message
...
worksheets(Array("Sheet1","Sheet4")).Copy
Activeworkbook.SaveAs "C:\My Folder\abc.xls"
--
Regards,
Tom Ogilvy

"new.microsoft.com" wrote in message
...
As subject, Thanks

How to write the code for copying 2 or more sheets to a new workbook at the same time?

Because you can't construct an array that way (tried it years ago myself).

Dim bReplace as Boolean
Dim i as Long, j as Long
Dim dept_code = String
For j = 5 To 99
dept_code = Right("0" & j, 2)
bReplace = True
For i = 1 To Worksheets.Count
if If Left(Worksheets(i).Name, 2) = dept_code Then
worksheets(i).Select bReplace
bReplace = False
end if
Next i
if Not bReplace then
ActiveWindow.SelectedSheets.copy
ActiveWorkbook.SaveAs Filename:= _
"C:\testing" & dept_code" & .xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close SaveChanges:=False
End If
Next j

--
Regards,
Tom Ogilvy

"new.microsoft.com" wrote in message
...
Hi, Tom
I don't know why the following code cannot work and with the error msg
(Run-time error '9' Subscript out of range), can you help?

For j = 5 To 99
dept_code = Right("0" & j, 2)
For i = 1 To Worksheets.Count

If Left(Worksheets(i).Name, 2) = dept_code Then
temp_array = temp_array & Chr(34) & Worksheets(i).Name & Chr(34) &
",
"
End If
Next i
temp_array = Left(temp_array, Len(temp_array) - 2)

If temp_array < "" Then
Sheets(Array(temp_array)).Copy
ActiveWorkbook.SaveAs Filename:= _
"C:\testing.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False,
_
CreateBackup:=False
ActiveWindow.Close
End If
temp_array = ""

Next j

"Tom Ogilvy" wrote in message
...
worksheets(Array("Sheet1","Sheet4")).Copy
Activeworkbook.SaveAs "C:\My Folder\abc.xls"
--
Regards,
Tom Ogilvy

"new.microsoft.com" wrote in message
...
As subject, Thanks

How to write the code for copying 2 or more sheets to a new workbook at the same time?

Thank you very much Tom, it works perfectly.

"Tom Ogilvy" wrote in message
...
Because you can't construct an array that way (tried it years ago myself).

Dim bReplace as Boolean
Dim i as Long, j as Long
Dim dept_code = String
For j = 5 To 99
dept_code = Right("0" & j, 2)
bReplace = True
For i = 1 To Worksheets.Count
if If Left(Worksheets(i).Name, 2) = dept_code Then
worksheets(i).Select bReplace
bReplace = False
end if
Next i
if Not bReplace then
ActiveWindow.SelectedSheets.copy
ActiveWorkbook.SaveAs Filename:= _
"C:\testing" & dept_code" & .xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close SaveChanges:=False
End If
Next j

--
Regards,
Tom Ogilvy

"new.microsoft.com" wrote in message
...
Hi, Tom
I don't know why the following code cannot work and with the error msg
(Run-time error '9' Subscript out of range), can you help?

For j = 5 To 99
dept_code = Right("0" & j, 2)
For i = 1 To Worksheets.Count

If Left(Worksheets(i).Name, 2) = dept_code Then
temp_array = temp_array & Chr(34) & Worksheets(i).Name & Chr(34) &
",
"
End If
Next i
temp_array = Left(temp_array, Len(temp_array) - 2)

If temp_array < "" Then
Sheets(Array(temp_array)).Copy
ActiveWorkbook.SaveAs Filename:= _
"C:\testing.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False,
_
CreateBackup:=False
ActiveWindow.Close
End If
temp_array = ""

Next j

"Tom Ogilvy" wrote in message
...
worksheets(Array("Sheet1","Sheet4")).Copy
Activeworkbook.SaveAs "C:\My Folder\abc.xls"
--
Regards,
Tom Ogilvy

"new.microsoft.com" wrote in message
...
As subject, Thanks