Delete unwanted sheets while copy the Workbook.

Hi Experts,

The attached macro able to copy and paste the workbook (attached) in a different location by removing “Data” sheet, other sheets are remained. Is that possible to revise the macro to delete all the sheets except “Data sheet”. The “Data” sheet should only consist Column A:C data and delete other object,  e.g. pictures. Hope Experts could help.

Sub exportWorkbook()
Dim fName As String
Dim wkb As Workbook
Dim wks As Worksheet
Dim mySht As Worksheet
Dim mySheets() As String
Dim i As Long
Dim newWkb As Workbook

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Data")
    
    fName = "D:\File Recovery\" & wks.Range("A1").Value & wks.Range("C4").Value & ".xls"
    'fName = ThisWorkbook.Path & "\" & wks.Range("A3").Value & wks.Range("C3").Value & ".xls"
    
    For Each mySht In ThisWorkbook.Worksheets
        If mySht.Name <> "Data" Then
            ReDim Preserve mySheets(i) As String
            mySheets(i) = mySht.Name
            i = i + 1
        End If
    Next mySht
    
    ReDim Preserve mySheets(UBound(mySheets) - 1)
    
    ThisWorkbook.Sheets(mySheets).Copy
    'Call RemoveAllMacros(ActiveWorkbook) 'in case there are macros in the sheet's codepages
    ActiveWorkbook.SaveAs Filename:=fName, FileFormat:=xlExcel8
    ActiveWorkbook.Close
    
    MsgBox "Successful export of " & fName
    Application.DisplayAlerts = False
    Application.ScreenUpdating = True
End Sub

Select allOpen in new window

Export-Sheet.xls