VBA Beginner

[sammy1985]

Hi

I am new to VBA and learning through trial and error. I am hoping there is an easy fix to this solution.

I want to split my Excel tabs into their documents without having to move/copy them. Assuming this is an easy task, I have looked at solutions to this and used code that is already online. However when I run the code I get an error and unable to work out why.

The code i am using is:

Sub SplitEachWorksheet()
Dim FPath As String
FPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
ws.Copy
Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


The error happens at ws.Copy

Can you guys please help and point me in the right direction. What am I doing wrong?

Much appreciated!!!


Sammy

 

[HaHoBe]

Hi Sammy,

my first guess was that you skip through all sheets in the workbook (including Charts, Dialogsheets and MacroSheets). For more inforamtion abiout that please see XlSheetType enumeration. Does the sheetname contain a pipe like "|" which is allowed for sheets but not for workbook names?

Maybe use this code for worksheets from the workbook holding the code:

Sub SplitEachWorksheet()
Dim FPath As String
Dim ws As Worksheet

FPath = ThisWorkbook.Path
If Len(FPath) = 0 Then
  MsgBox "Workbook has not been saved yet, please start macro again after saving.", vbInformation, "Ending here"
  Exit Sub
End If
With Application
  .ScreenUpdating = False
  .DisplayAlerts = False
End With
For Each ws In ThisWorkbook.Worksheets
  ws.Copy
  ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
  ActiveWorkbook.Close False
Next ws
With Application
  .DisplayAlerts = True
  .ScreenUpdating = True
End With
End Sub

For the active workbook code may look like this

Sub SplitEachWorksheet_ActiveWorkbook()
Dim FPath As String
Dim wbAct As Workbook
Dim ws As Worksheet

Set wbAct = ActiveWorkbook
FPath = wbAct.Path
If Len(FPath) = 0 Then
  MsgBox "Workbook has not been saved yet, please start macro again after saving.", vbInformation, "Ending here"
  GoTo end_here
End If
With Application
  .ScreenUpdating = False
  .DisplayAlerts = False
End With
For Each ws In wbAct.Worksheets
  ws.Copy
  ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
  ActiveWorkbook.Close False
Next ws

end_here:
Set wbAct = Nothing
With Application
  .DisplayAlerts = True
  .ScreenUpdating = True
End With
End Sub

Ciao,
Holger

 

[HaHoBe]

Hi Sammy,

are there any sheets in the workbok which are hidden as that would cause the code to break?

Altered code for visible sheets:

Sub SplitEachWorksheet()
Dim FPath As String
Dim ws As Worksheet

FPath = ThisWorkbook.Path
If Len(FPath) = 0 Then
  MsgBox "Workbook has not been saved yet, please start macro again after saving.", vbInformation, "Ending here"
  Exit Sub
End If
With Application
  .ScreenUpdating = False
  .DisplayAlerts = False
End With
For Each ws In ThisWorkbook.Worksheets
  If ws.Visible = xlSheetVisible Then
    ws.Copy
    ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
    ActiveWorkbook.Close False
  End If
Next ws
With Application
  .DisplayAlerts = True
  .ScreenUpdating = True
End With
End Sub

Holger