Repeat this macro for all sheets in a workbook

[rjdrury]

How to I change the code below so it will run for all sheets in the workbook?

Sub Splitbook()
MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
sht.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.Saveas _
Filename:=MyPath & "" & sht.Name & ".xls"
With Application
.DisplayAlerts = False
.ScreenUpdating = False
With ActiveWorkbook
.Saveas FileFormat:=xlNormal, Password:="2012270400", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
.Close
End With
.ScreenUpdating = True
.DisplayAlerts = True
End With
ActiveWorkbook.Close savechanges:=False
Next sht
End Sub

 

[Joe4]

Welcome to the Board!

Try changing all your references of "ActiveSheet." to "sht."
Since you are not selecting any sheets in your code, ActiveSheet will always refer to the sheet that was active when the code started.

 

[rjdrury]

Welcome to the Board!

Try changing all your references of "ActiveSheet." to "sht."
Since you are not selecting any sheets in your code, ActiveSheet will always refer to the sheet that was active when the code started.

Still stops running after the first sheet is processed

 

[Joe4]

That is because you are closing the activeworkbook.

What exactly are trying to do? Are you trying to copy each sheet to a separate workbook?
If so, you need to create a new workbook to copy into. It looks like you are just copying the file onto itself and closing it.

 

[rjdrury]

Thanks for the reply.

I am trying to split the sheets in one workbook into separate workbooks and save those workbooks with a password.

I found some new code on the web for splitting the worksheets into separate workbooks and inserted the line ActiveWorkbook.SaveAs Password:="Password"

That solved the problem.

Sub Splitbooka()
'Updateby20140612
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
xWs.Copy
Application.ActiveWorkbook.SaveAs Filename:=xPath & "" & xWs.Name & ".xlsx"
ActiveWorkbook.SaveAs Password:="Password"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub