Select and copy certain tabs using macro

[FLORERO]

I am working with a workbook in Excel 2003 that has over 40 tabs
(worksheets). Each worksheet is a department report and each department has 4
reports. The last report is the one I need to select for each department and
copy it into a new workbook. The name of the worksheets to be selected copied
and pasted is "xxxxx-RSS Upload" where x is the department number. I was
trying to find a property that could only select the "Upload" part of the
worksheet name as a common denominator to select multiple worksheets that end
with that text string. I started of like this:

Sub Macro3()
Dim ws As Worksheet
For Each ws In Worksheets
If UCase(Right(Trim(ws.Name), 6)) = "UPLOAD" Then
ws.Select
ws.Copy After:=Workbooks("newbook"). _
Worksheets(Workbooks("newbook").Worksheets.Count)
End If
Next ws

End Sub

The Macro stops and gets error '9': Subscript out of range

The debugger directs me to the following line:
ws.Copy After:=Workbooks("newbook"). _
Worksheets(Workbooks("newbook").Worksheets.Count)

If I remove this line the Macro works fine selecting only the tabs i want,
so I know I am halfway in the right direction. Can anybody come up with a
solution for this??? Thanks in advance for your help

 

[Don Guillett]

WithOUT testing how about newbook.xls

 

[john]

changed your code abit but this seemed to work but assumes NewBook exists and
is open:

Sub Macro()
Dim ws As Worksheet
Dim Dwb As Workbook
Dim Awb As Workbook

Set Awb = ActiveWorkbook
Set Dwb = Workbooks("NewBook")
Application.ScreenUpdating = False
cws = Dwb.Worksheets.Count
For Each ws In Worksheets
If UCase(Right(Trim(ws.Name), 6)) = "UPLOAD" Then
ws.Select
ws.Copy After:=Workbooks("NewBook").Worksheets(cws)
End If
Awb.Activate
Next ws
Application.ScreenUpdating = True
End Sub

 

[FLORERO]

I had already tried that. Thanks.

WithOUT testing how about newbook.xls

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

 

[Don Guillett]

Try creating the new workbook first>name it>then copy sheets to it
or this may be quicker
delete all sheets not containing the text and then saveAS something else.

 

[FLORERO]

Thank you very much John it worked

changed your code abit but this seemed to work but assumes NewBook exists and
is open:

Sub Macro()
Dim ws As Worksheet
Dim Dwb As Workbook
Dim Awb As Workbook

Set Awb = ActiveWorkbook
Set Dwb = Workbooks("NewBook")
Application.ScreenUpdating = False
cws = Dwb.Worksheets.Count
For Each ws In Worksheets
If UCase(Right(Trim(ws.Name), 6)) = "UPLOAD" Then
ws.Select
ws.Copy After:=Workbooks("NewBook").Worksheets(cws)
End If
Awb.Activate
Next ws
Application.ScreenUpdating = True
End Sub

 

[john]

Glad to be of help. If you want to create a New workbook programmatically you
could try following: (untested)

Sub Macro()
Dim ws As Worksheet
Dim Dwb As Workbook
Dim Awb As Workbook

Application.ScreenUpdating = False

Set Awb = ThisWorkbook
Set Dwb = Workbooks.Add
Dwb.SaveAs "C:\NewBook"

For Each ws In Awb.Worksheets
If UCase(Right(Trim(ws.Name), 6)) = "UPLOAD" Then
ws.Copy After:=Workbooks(Dwb.Name).Worksheets _
(Workbooks(Dwb.Name).Worksheets.Count)
End If
Awb.Activate
Next ws
Application.ScreenUpdating = True
End Sub

 

[Don Guillett]

Try this idea instead
=SUM(U7:OFFSET(U7,0,d3-1))