Hi Paul. The Macro worked-Thank you. I am trying to save the workbooks as a name in a reference cell "F7" in each of the
workbooks. I have tried updating the code but received another error. Where should I put this reference in the code?
If you mean that you want the created workbooks to be named based on the F7 on each worksheet, change
sPath2 = sPath1 & Application.PathSeparator & ws.Name
to
sPath2 = sPath1 & Application.PathSeparator & ws.Range("F7").Text
But to handle the case where these is a error (#DIV/0! or some other problem) in F7, I added a little error handling
Option Explicit
Sub SplitSheets()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim sPath1 As String, sPath2 As String
Set wb1 = ThisWorkbook
sPath1 = wb1.Path
Application.ScreenUpdating = False
For Each ws In wb1.Worksheets
If ws.Visible Then
ws.Copy
Set wb2 = ActiveWorkbook
sPath2 = sPath1 & Application.PathSeparator & ws.Range("F7").Text
On Error Resume Next
Kill sPath2 & ".xlsx"
On Error GoTo 0
On Error GoTo CanNotSaveIt
Call wb2.SaveAs(sPath2, xlOpenXMLWorkbook)
Call wb2.Close(False)
End If
Next
wb1.Activate
Application.ScreenUpdating = False
Exit Sub
CanNotSaveIt:
Call MsgBox("Can not save" & vbCrLf & vbCrLf & sPath2, vbCritical + vbOKOnly, "Split Workbook")
Resume Next
End Sub