VBA copy selected sheets in a new workbook as values

[johnjeko]

Hi folks,

I'm terrible with VBA but I'm looking for a code that:
1) erase all files in a specific folder (eg. desktop\report).
2) extract some sheets from a workbook (eg. "Sheet1", "Sheet2", "Sheet3")
3) create a new workbook with the above sheets pasted as values ("Sheet1", "Sheet2", "Sheet3" have pivots in them. I would like to keep the cells formats but remove the pivots. So basically values with original cell formats)
4) save the new workbook as a "Report1" to the folder "desktop\report"
5) repeat points 2-3-4 for additional sheets in the main workbook (eg. "Sheet4", "Sheet5", "Sheet6") and save them as Report2 in the same folder.
6) some sheets have also charts in them. So I guess I would like to break the links for the charts as well. Thank you all!!!!!!

I will thank you forever for your help!

 

[DrSimon]

I think I've done all apart from 6. I don't use charts that often and not sure what you want doing with them.

Sub CopySheets()
Dim fs
Dim Folder As String
Dim Wb1 As Workbook
Dim NShts1 As Integer
Dim Wb2 As Workbook
Dim Wb2ID As Integer
Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim S As Integer
Dim Sht2ID As Integer
Dim RepNo As Integer
Dim Sht1ID As Integer
Dim PT As PivotTable
Dim ShtName As String

' Erase all files in the folder named below
Folder = "C:\Workfile\Reports"
Set fs = CreateObject("Scripting.FileSystemObject")
For Each File In fs.GetFolder(Folder).Files
    'If fs.GetExtensionName(File) = "xlsx" Then  ' example of way to filter if required
        fs.DeleteFile File
    'End If
Next

' Macro written to be run using the active workbook as the data source
Set Wb1 = ActiveWorkbook
NShts1 = Wb1.Worksheets.Count
RepNo = 0
' request indicates that 3 sheets to be saved per report
For S = 1 To NShts1 Step 3
    ' Create new workbook and remove all but one sheet - not always needed
    Set Wb2 = Workbooks.Add
    For Each Sht2 In Wb2.Worksheets
        If Sht2.Index <> 1 Then Sht.Delete
    Next Sht2
    Wb2.Sheets(1).Name = "ToBeDeleted"  ' Giving the remaining sheet a name that won't exist
    Sht2ID = 0
    For Sht1ID = S To S + 2  ' Get next 3 sheets from active workbook
        Sht2ID = Sht2ID + 1
        On Error Resume Next  '  Next line will error if there aren't 3 sheets in this iteration
        Wb1.Sheets(Sht1ID).Copy After:=Wb2.Sheets(Sht2ID) ' Copies the sheet including name
        ' Get rid of pivots
        ShtName = Wb1.Sheets(Sht1ID).Name
        For Each PT In Wb2.Sheets(ShtName).PivotTables
            PT.TableRange2.Clear
        Next PT
        ' Code to break chart links for the sheet would need to go here
        On Error GoTo 0
    Next Sht1ID
    
    Application.DisplayAlerts = False  ' stops alert asking to confirm deletion
    Wb2.Sheets(1).Delete ' Get rid of the sheet that was left after deleting all the rest
    Application.DisplayAlerts = True

    RepNo = RepNo + 1
    Wb2.SaveAs Folder & "\Report" & RepNo & ".xlsx"
    Wb2.Close
Next S
' Active worksheet remains open
MsgBox RepNo & " reports created", vbInformation
Set Wb1 = Nothing
Set Wb2 = Nothing

End Sub