Problem with Worksheet Extraction 1

[robcarr]

Dear All,

I am using the coding below to loop through all the sheets except 1(Team Summary) in a workbook, and copy the data from each sheet to a new 1 sheet workbook and then save that workbook in a location depending on the sheet name, It works fine for the first 6 sheets and always crashed on the 7th sheet, is there away to make this easier, the data I have is 11 teams of refund data,in the workings sheet is a list of all team names with the pathname next to it. Does anyone know why it keeps crashing and does anyone know how to make this easier.

Sub copyagentsheets()
Dim newsheets As Long, OldSheets As Long
Windows("New weekly refund template.xls&quot.Activate
ActiveWindow.ActivateNext
For Each wwsht In Sheets(Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11))
wwsht.Select
sname = [d7].Value
If [d1].Value = 0 Then GoTo ehand
OldSheets = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = "1"
Workbooks.Add
Application.SheetsInNewWorkbook = OldSheets
ActiveWindow.ActivateNext
Cells.Copy
ActiveWindow.ActivatePrevious
ActiveSheet.Paste
ActiveSheet.Name = sname
ActiveWindow.ActivateNext
Windows("New Weekly Refund Template.xls&quot.Activate
Sheets("workings&quot.Select
Columns("a:a&quot.Select
Selection.Find(What:=sname, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
savename = ActiveCell.Offset(0, 2).Value
ActiveWindow.ActivatePrevious
ActiveWorkbook.SaveAs Filename:=savename, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
savename = 0
ActiveWorkbook.Close
ActiveWindow.ActivateNext
ehand:
Next wwsht
End Sub

Thanks




Thanks Rob.

 

[SkipVought]

rob,
On what statement does it crater?

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[robcarr]

it crashes on the save workbook command, the savename variable shows the correct, path and location but the error dialog box shows two filenames combined.

Thanks

Thanks Rob.

 

[robcarr]

it crashes on the save workbook command, the savename variable shows the correct, path and location but the error dialog box shows two filenames combined.

Thanks

Thanks Rob.

 

[SkipVought]

and when you do a debug and look at the value of savename, it indeed has the correct value?

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[robcarr]

yes, everything shows that it should go to the correct place, but the debug error shows a different value to savename

rob.

Thanks Rob.

 

[SkipVought]

I constructed a workbook that seemed to parallel your, modified the code to be a bit more streamline.

Actually I ran BOTH your code and mine and both worked. I have no idea why yours errors off on 7. You must have something strange going on in your "workings" sheet.

Here's mind just for grins...

Sub NEWcopyagentsheets()
    Dim wbThis As Workbook, wbNew As Workbook, wsThis As Worksheet
    Set wbThis = ActiveWorkbook
    Set wsThis = Worksheets("workings")
    For Each wwsht In Sheets(Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11))
        With wwsht
            sname = .[d7].Value
            For Each a In wsThis.Range("A:A")
                If a.Value = sname Then
                   savename = a.Offset(0, 2).Value
                   Exit For
                End If
            Next
            If .[d1].Value = 0 Then GoTo eHand
            If savename = 0 Then GoTo eHand
            .Copy       'copy the worksheet to a new workbook
            Set wbNew = ActiveWorkbook
            With wbNew
                .ActiveSheet.Name = sname
                .SaveAs Filename:=savename, FileFormat:=xlNormal, _
                    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
                    CreateBackup:=False
                .Close
            End With
            savename = 0
        End With
eHand:
    Next wwsht
End Sub

Hope this helps

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[robcarr]

Skip,

I found the problem, I had missed off the "\" at the start of the file name for the one in question, thanks for your help on this I will make sure I triple check next time, but i have learnt some new ways of coding.

thanks again for all your time.

Rob.

Thanks Rob.