Sub SavesSheets() Application.ScreenUpdating = False Worksheets("PivotTables(1)").Activate 'Creates an individual workbook for each worksheet in the active workbook. Dim wbDest As Workbook Dim wbSource As Workbook Dim sht As Object 'Could be chart, worksheet, Excel 4.0 macro,etc. Dim strSavePath As String On Error GoTo ErrorHandler Application.ScreenUpdating = False 'Don't show any screen movement strSavePath = "U:\Maintenance\4.Measurement & Specification\Reports\Central Reports\5.Outstanding SCPs\Lists for Sub Contractors\Pending Jobs" 'Change this to suit your needs Set wbSource = ActiveWorkbook For Each sht In wbSource.Sheets sht.Copy Set wbDest = ActiveWorkbook wbDest.SaveAs strSavePath & sht.Name wbDest.Close 'Remove this if you don't want each book closed after saving. Next Application.ScreenUpdating = True Exit Sub ErrorHandler: 'Just in case something hideous happens MsgBox "An error has occurred. Error number=" & Err.Number & ". Error description=" & Err.Description & "." End Sub