Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Multiple Sheets, Except Q
How could I tweak the code below that will copy all sheets from my
ActiveWorkbook EXCEPT for sheets A;B and C? Code below will copy 2 specified sheets, but I want to twist this around as I have a large number to copy and don't want to hard code them as below Set Sourcewb = ActiveWorkbook Sourcewb.Sheets(Array("Header", "Order")).Copy Set Destwb = ActiveWorkbook |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Multiple Sheets, Except Q
Sub CopyBook() First = True For Each Sht In ThisWorkbook.Sheets Select Case Sht.Name Case "A", "B", "C" 'Do Nothing Case Else If First = True Then 'Create New workbook Sht.Copy Set NewBk = ActiveWorkbook First = False Else With NewBk Sht.Copy after:=.Sheets(.Sheets.Count) End With End If End Select Next Sht End Sub "Seanie" wrote: How could I tweak the code below that will copy all sheets from my ActiveWorkbook EXCEPT for sheets A;B and C? Code below will copy 2 specified sheets, but I want to twist this around as I have a large number to copy and don't want to hard code them as below Set Sourcewb = ActiveWorkbook Sourcewb.Sheets(Array("Header", "Order")).Copy Set Destwb = ActiveWorkbook |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Multiple Sheets, Except Q
Thanks Joel, are the sheet names case sensitive within the code?
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Multiple Sheets, Except Q
The test using strings ze case sensitive
from Select Case Sht.Name to Select Case Ucase(Sht.Name) The make sure the name in this statement is all capital Case "A", "B", "C" "Joel" wrote: Sub CopyBook() First = True For Each Sht In ThisWorkbook.Sheets Select Case Sht.Name Case "A", "B", "C" 'Do Nothing Case Else If First = True Then 'Create New workbook Sht.Copy Set NewBk = ActiveWorkbook First = False Else With NewBk Sht.Copy after:=.Sheets(.Sheets.Count) End With End If End Select Next Sht End Sub "Seanie" wrote: How could I tweak the code below that will copy all sheets from my ActiveWorkbook EXCEPT for sheets A;B and C? Code below will copy 2 specified sheets, but I want to twist this around as I have a large number to copy and don't want to hard code them as below Set Sourcewb = ActiveWorkbook Sourcewb.Sheets(Array("Header", "Order")).Copy Set Destwb = ActiveWorkbook |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Multiple Sheets, Except Q
Great, I got it to work as below. Finally how could I place a Msg Box
pop up, if there are no sheets to copy, i.e. the only sheets that are in the source workbook are A,B,C,D? First = True For Each sht In ThisWorkbook.Sheets Select Case sht.Name Case "Header", "A", "B", "C", "D" 'Do Nothing Case Else If First = True Then 'Create New workbook sht.Copy Set Destwb = ActiveWorkbook First = False Else With Destwb sht.Copy after:=.Sheets(.Sheets.Count) End With End If End Select Next sht |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Multiple Sheets, Except Q
Add and IF statement at the bottom like below.
First = True For Each sht In ThisWorkbook.Sheets Select Case sht.Name Case "Header", "A", "B", "C", "D" 'Do Nothing Case Else If First = True Then 'Create New workbook sht.Copy Set Destwb = ActiveWorkbook First = False Else With Destwb sht.Copy after:=.Sheets(.Sheets.Count) End With End If End Select Next sht If First = True then msgbox("No sheets found to copy") End IF "Seanie" wrote: Great, I got it to work as below. Finally how could I place a Msg Box pop up, if there are no sheets to copy, i.e. the only sheets that are in the source workbook are A,B,C,D? First = True For Each sht In ThisWorkbook.Sheets Select Case sht.Name Case "Header", "A", "B", "C", "D" 'Do Nothing Case Else If First = True Then 'Create New workbook sht.Copy Set Destwb = ActiveWorkbook First = False Else With Destwb sht.Copy after:=.Sheets(.Sheets.Count) End With End If End Select Next sht |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Multiple Sheets, Except Q
Thanks, It debugs with message "Copy Method of Worksheet class failed"
on text sht Copy This is when there are no sheets apart from A,B,C,D. If I have a sheet other than those, code works fine |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Multiple Sheets, Except Q
Your description of the failure doesn't make sense. If you have only A,B,C,D
then you will never do a copy so your won't get to the failure you are descriping. Post all your code so I can see the changes you made. "Seanie" wrote: Thanks, It debugs with message "Copy Method of Worksheet class failed" on text sht Copy This is when there are no sheets apart from A,B,C,D. If I have a sheet other than those, code works fine |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Multiple Sheets, Except Q
I won't need to do a copy, but as the file goes out to a couple of
users, they might just action the macro and hence that is why I'd like to see the Msb Box, wouldn't look good if they did and then they get the debug message. As I've said code works fine if I have a sheet to copy, but if not debugs as above. Full Code is:- Sub Mail_Database() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet Dim strbody As String With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook First = True For Each sht In ThisWorkbook.Sheets Select Case sht.Name Case "A", "B", "C", "D" 'Do Nothing Case Else If First = True Then 'Create New workbook sht.Copy Set Destwb = ActiveWorkbook First = False Else With Destwb sht.Copy after:=.Sheets(.Sheets.Count) End With End If End Select Next sht If First = True Then MsgBox ("There are no Historic Orders to E-Mail") End If With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else FileExtStr = ".xls": FileFormatNum = 56 End If End If End With TempFilePath = Environ$("temp") & "\" TempFileName = "Database Extraction from " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm") & "~" ActiveWindow.TabRatio = 0.908 Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon Set OutMail = OutApp.CreateItem(0) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = " .CC = "" .BCC = "" .Subject = "Database of Orders" .Body = "" .Attachments.Add Destwb.FullName .ReadReceiptRequested = True .SendUsingAccount = OutApp.Session.Accounts.Item(1) .Send End With On Error GoTo 0 .Close savechanges:=False End With Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy Multiple Sheets, Except Q
I ran you code and didn't get any problems on the line
sht.Copy This line has a period between sht and copy which you didn't have in the previous posting where you said you had a problem. I tried repeating the problem by using different number of sheets in my workbook but still didn't repeat your problem. When you use COPY on a sheet without the parameter AFTER or BEFORE excel creates a new workbook. The new workbook only has one sheet (the one you copied) and doesn't have any macros. I like this procedure better than using Workbooks.Add because the Add method will create a new workbook with 3 blank worksheets (or whatever you have the defualt number of sheets set to in Tools - Option). I would also rewrite this section of code With Destwb If First = False then .SaveAs TempFilePath & TempFileName &FileExtStr, _ FileFormat:=FileFormatNum End if With OutMail .To = " .CC = "" .BCC = "" .Subject = "Database of Orders" If First = true then .Body = "There are no Historic Orders to E-Mail" Else .Body = "" .Attachments.Add Destwb.FullName End if .ReadReceiptRequested = True .SendUsingAccount = OutApp.Session.Accounts.Item(1) .Send End With .Close savechanges:=False End With If First = False then Kill TempFilePath & TempFileName & FileExtStr End If "Joel" wrote: Your description of the failure doesn't make sense. If you have only A,B,C,D then you will never do a copy so your won't get to the failure you are descriping. Post all your code so I can see the changes you made. "Seanie" wrote: Thanks, It debugs with message "Copy Method of Worksheet class failed" on text sht Copy This is when there are no sheets apart from A,B,C,D. If I have a sheet other than those, code works fine |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
copy rows to multiple sheets | Excel Discussion (Misc queries) | |||
Copy multiple sheets using a list box | Excel Programming | |||
Copy & Past from multiple sheets to one | Excel Programming | |||
Multiple sheets selection and copy | Excel Programming | |||
Copy from Multiple Sheets | Excel Programming |