Copy all sheets to new individual workbooks

I have something similar that you can modify:

Sub copy_QC_file()


    ActiveWorkbook.Save

'
'is macro file ..
    workbook1 = ActiveWorkbook.Name
    
'set folder for copy
    copy_dir$ = Worksheets("Data").Cells(1, 22)

'set name  for copy file
    rl$ = Worksheets("Data").Cells(6, 1)
    name3$ = "RL " & rl$ & "Output"


'select worksheets to copy to new file

    Sheets(Array("Data", "Graphs")).Select
    Sheets(Array("Data", "Graphs")).Copy
    
    ChDir copy_dir$
    
    Worksheets("Data").Cells(1, 22) = ""
    Worksheets("Data").Cells(6, 1) = ""
     
    ActiveWorkbook.SaveAs Filename:= _
        name3$ & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Close
    
    Workbooks(workbook1).Worksheets("Data").Select
    Range("A1").Select
    
    

    End Sub

Basically, mine copies the sheets named 'Data & Graphs' to a new sheet based on the file name contained in cell 6,1 with a prefix of 'RL' and suffix of 'output'. It also clears these values output, but the bare bones is there. The directory to save is stored in cell 1,22 on the main sheet.

Try this code - Change the highlighted section - Keep this code in the file which contains the sheets which need to be saved -

Sub save_files()
Dim wb As Workbook
Dim i As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 1 To ThisWorkbook.Worksheets.Count
    With ThisWorkbook.Worksheets(i)
        .Cells.Copy
        Set wb = Workbooks.Add
        wb.Worksheets(1).Range("A1").PasteSpecial (xlPasteValuesAndNumberFormats)
        Application.CutCopyMode = False
        wb.SaveAs ("B:\Test\" & .Range("B2").Value & " " & .Range("C2").Value & ".xlsx")
        wb.Close
    End With
Next i

MsgBox "Files complete"

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Copy the Excel VBA code
Select the workbook in which you want to store the Excel VBA code
Hold the Alt key, and press the F11 key, to open the Visual Basic Editor
Choose Insert | Module
Where the cursor is flashing, choose Edit | Paste

To run the Excel VBA code:
Choose View | Macros
Select a macro in the list, and click the Run button

arlu1201 that works great, apart from it's not copying the formatting across or the graphs that are in the orignal tabs

edit - I've tried changing it to match another macro I had that alost did the same thing, but it's still only copying the data and not formats or graohs

Try this.

Sub ExplodeWB()
Dim wbNew As Workbook 
Dim ws As Worksheet
Dim strPath As String
Dim strFileName As String

   strPath = ThisWorkbook.Path

   For Each ws In ThisWorkbook.Worksheets

      strFileName = ws.Range("B2").Value &  " "& ws.Range("C2").Value
      ws.Copy

      Set wbNew = ActiveWorkbook

      With wbNew
          .SaveAs strPath &"\" & strFileName
          .Close False
       End With

   Next ws

End Sub

Hi Norie - this is failing at

.SaveAs strPath &"\" & strFileName

any idea why
Also, I've had to change the Vlaue after C2 to "text" as C2 is a date and it didn't like it

edit - fixed the first part, my sheet 1 had blank values in those cells as it's the front sheet.
next issue is that this is copying the formulae across, when I just want the values

How is it failing?

How is the date formatted?

Bill

In the first post you only wanted to copy the worksheets, no mention of formats or values.

Anyway to get only values try this.

      Set wbNew = ActiveWorkbook

      With wbNew
            .Worksheets(1).UsedRange.Copy
            .Worksheets(1).Range("A1").PasteSpecial xlPasteValues
          .SaveAs strPath &"\" & strFileName
          .Close False
       End With

   Next ws

End Sub

Bill

In brackets.