• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 284
  • Last Modified:

Delete Sheet

Hi,

Need Experts help to add additional function in the attached script. Need to delete "Filter" sheet when run this sub. Currently the macro only deleting a "Data" sheet from the workbook.  
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 = 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
    Call ExportPlanningSheet
    
End Sub

Open in new window

0
Billa7
Asked:
Billa7
  • 2
  • 2
1 Solution
 
StephenJRCommented:
I think we need to see the code for RemoveAllMacros.
0
 
Billa7Author Commented:
Hi StephenJR,

Attached the Macro.
Sub RemoveAllMacros(objDocument As Object)
' deletes all VBProject components from objDocument
' removes the code from built-in components that can't be deleted
' use like this: RemoveAllMacros ActiveWorkbook ' in Excel
' or like this: RemoveAllMacros ActiveWorkbookDocument ' in Word
' requires a reference to the
' Microsoft Visual Basic for Applications Extensibility library
Dim I As Long, l As Long
    If objDocument Is Nothing Then Exit Sub
    I = 0
    On Error Resume Next
    I = objDocument.VBProject.VBComponents.Count
    On Error GoTo 0
    If I < 1 Then ' no VBComponents or protected VBProject
        MsgBox "The VBProject in " & objDocument.Name & _
            " is protected or has no components!", _
            vbInformation, "Remove All Macros"
        Exit Sub
    End If
    With objDocument.VBProject
        For I = .VBComponents.Count To 1 Step -1
            On Error Resume Next
            .VBComponents.Remove .VBComponents(I)
            ' delete the component
            On Error GoTo 0
        Next I
    End With
    With objDocument.VBProject
        For I = .VBComponents.Count To 1 Step -1
            l = 1
            On Error Resume Next
            l = .VBComponents(I).CodeModule.CountOfLines
            .VBComponents(I).CodeModule.DeleteLines 1, l
            ' clear lines
            On Error GoTo 0
        Next I
    End With
End Sub

Open in new window

0
 
StephenJRCommented:
Sorry, misread your question. At the moment your code doesn't delete any sheets, it just copies all of them except Data to a new workbook. Are you saying you don't want Filter copied across either? If that's right just change line 19 to
If mySht.Name <> "Data" And mySht.Name <> "Filter" Then

Open in new window

0
 
Billa7Author Commented:
Thanks StephenJR for the help
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now