VBA code to split sheets and save as seperate CSV files

Hello

I am wondering if anyone can help.

I have a spreadsheet that we receive that contains 8 different sheets.

I am looking to create a macro that splits these 8 different sheets into seperate workbooks and saves them as a CSV file?

Thanks

McC

This will work with up to 8 worksheets, it will name each new CSV workbook by the name of the actual worksheet being moved. It will leave the original workbook intact (As a backup, I did not want to delete sheets from the original workbook.)

Sub Test1()
    Dim i As Integer
    Dim ws As Worksheet
    Dim CntSheets As Long

    Application.DisplayAlerts = False
    For i = 1 To Worksheets.Count
        CntSheets = Worksheets.Count
        'MsgBox CntSheets
        If CntSheets = "8" Then
            Sheets("Sheet" & CntSheets).Move
            ActiveWorkbook.SaveAs Filename:="U:\" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, _
                                  CreateBackup:=False
            ActiveWindow.Close
        End If
        If CntSheets = "7" Then
            Sheets("Sheet" & CntSheets).Move
            ActiveWorkbook.SaveAs Filename:="U:\" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, _
                                  CreateBackup:=False
            ActiveWindow.Close
        End If
        If CntSheets = "6" Then
            Sheets("Sheet" & CntSheets).Move
            ActiveWorkbook.SaveAs Filename:="U:\" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, _
                                  CreateBackup:=False
            ActiveWindow.Close
        End If
        If CntSheets = "5" Then
            Sheets("Sheet" & CntSheets).Move
            ActiveWorkbook.SaveAs Filename:="U:\" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, _
                                  CreateBackup:=False
            ActiveWindow.Close
        End If
        If CntSheets = "4" Then
            Sheets("Sheet" & CntSheets).Move
            ActiveWorkbook.SaveAs Filename:="U:\" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, _
                                  CreateBackup:=False
            ActiveWindow.Close
        End If
        If CntSheets = "3" Then
            Sheets("Sheet" & CntSheets).Move
            ActiveWorkbook.SaveAs Filename:="U:\" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, _
                                  CreateBackup:=False
            ActiveWindow.Close
        End If
        If CntSheets = "2" Then
            Sheets("Sheet" & CntSheets).Move
            ActiveWorkbook.SaveAs Filename:="U:\" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, _
                                  CreateBackup:=False
            ActiveWindow.Close
        End If
        If CntSheets = "1" Then
            ActiveWorkbook.SaveAs Filename:="U:\" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, _
                                  CreateBackup:=False
        End If
    Next i
EndIt:
    Application.DisplayAlerts = True
End Sub

Hi

I have tried running the above code, however, nothing appears to happen?

Any suggestions?

Thanks again
Much appreciated

Hi

Can anyone help please?

Thanks

Hi

Thanks for getting back to me.

I have already changed the file path to my own drive and it still does not appear to work?

Thanks again