Macro to split a workbook

[BarbK]

I need help with VBA code to split a workbook and save each individual worksheet as a new workbook. I have XL 2010, but others who will use this file have 2007. <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

[FONT=Arial]Below is the code I have so far:<o:p></o:p>[/FONT]
[FONT=Arial][FONT=Arial]   Dim sht As Worksheet<o:p></o:p>[/FONT]
[FONT=Arial]    Dim MyCurrPath As String<o:p></o:p>[/FONT]
[FONT=Arial]    MyCurrPath = ThisWorkbook.Path<o:p></o:p>[/FONT]
[FONT=Arial]    ainput = InputBox("Enter Date for this report")<o:p></o:p>[/FONT]
[FONT=Arial]    For Each sht In ActiveWorkbook.Worksheets<o:p></o:p>[/FONT]
[FONT=Arial]        sht.Copy<o:p></o:p>[/FONT]
[FONT=Arial]    ActiveWorkbook.SaveAs Filename:= _<o:p></o:p>[/FONT]
[FONT=Arial]    MyCurrPath & "\" & sht.Name & " OTC Report " & ainput & ".xlsm" _<o:p></o:p>[/FONT]
[FONT=Arial]    , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False<o:p></o:p>[/FONT]
[FONT=Arial]    ActiveWindow.Close<o:p></o:p>[/FONT]
[FONT=Arial]    Next sht<o:p></o:p>[/FONT]
[FONT=Arial]End Sub<o:p></o:p>[/FONT]
[/FONT]

The code works unitl the last sheet is copied. Then I get a Runtime Error ‘1004’ Method ‘Copy of Object’_Worksheet failed.<o></o>
I’m a macro newbie & would appreciate any advice on where I’ve gone wrong.<o></o>

 

[JackDanIce]

Could change it to:

Sub CopyThing ()
Dim i as Long
Dim MyCurrPath As String<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
MyCurrPath = ThisWorkbook.Path<o:p></o:p>
ainput = InputBox("Enter Date for this report")<o:p></o:p>
For i = 1 to activeworkbook.worksheets.count
 Sheets(i).Copy<o:p></o:p>
 ActiveWorkbook.SaveAs Filename:= _<o:p></o:p>
 MyCurrPath & "\" & sheets(i).Name & " OTC Report " & ainput & ".xlsm" _<o:p></o:p>
 , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False<o:p></o:p>
 ActiveWindow.Close<o:p></o:p>
Next i
End Sub

<o></o>

 

[BarbK]

Thanks so much for your very prompt reply! I've tried your code & the first sheet is copied & saved. Original file left untouched, so that's good. Then Sheet 2 is copied but not yet saved. I get a new error message: "Runtime Error 9: Subscript out of range" Code breaks here: ActiveWorkbook.SaveAs Filename:= _

 

[BarbK]

Thanks so much for your very prompt reply! I've tried your code & the first sheet is copied & saved. Original file left untouched, so that's good. Then Sheet 2 is copied but not yet saved. I get a new error message: "Runtime Error 9: Subscript out of range" Code breaks here: ActiveWorkbook.SaveAs Filename:= _

Bump
Does anyone have another idea? I've tried the suggested solution and now get a Runtime Error.