Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 21
Default How to write the code for copying 2 or more sheets to a new workbook at the same time?

As subject, Thanks


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default 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




  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 21
Default 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






  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default 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








  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 21
Default 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










Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How to repeat a code for selected sheets (or a contiguous range of sheets) in a Workbook? Dmitry Excel Worksheet Functions 6 March 29th 06 12:43 PM
Application error when attempting to write code to a workbook Jared Excel Programming 1 November 17th 04 08:17 PM
Copying sheets without code Les Gordon Excel Programming 4 November 13th 04 05:22 AM
Workbook Last Write Date Time Yong Excel Programming 2 May 4th 04 01:01 PM
Write to closed workbook code Todd Huttenstine[_3_] Excel Programming 4 May 4th 04 09:59 AM


All times are GMT +1. The time now is 12:30 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"