VBA to copy tab, clear contents & formats and save new as a specific name

[delaney1102]

hi all, i inherited the below code in a workbook i'm using, but i keep getting a run-time error 91 on the line that starts with W.Worksheets. i'll explain what i'm trying to do if someone could help me out, thank you!! i dummied up some of the info below like tab names and ranges, but the rest is an exact copy of the coding. using microsoft 365 enterprise

The Compare tab is in a large workbook and is password protected. I want to copy just that tab into a new workbook, clear only some formatting but keep the rest and clear some contents and then save the new single tab with a specific name. currently the Save As dialog box opens and then I can pick where it gets saved, and that's totally fine. Both worksheets can stay open. I want the original tab in the big workbook to stay unchanged.


Sub export()

Dim FName As String, DefaultName As String
Dim W As Workbook


DefaultName = "Compare - " & Range("A1") & ".xlsx"
FName = Application.GetSaveAsFilename(InitialFileName:=DefaultName, filefilter:="Excel Files (*.xlsx), *.xlsx")
W.Worksheets("Compare").Unprotect Password:="xxxx", userinterfaceonly:=True
Range("A20:B30").ClearContents
Range("A20:B30").ClearFormats
Range("A40:B50").ClearContents
Range("A50:B40").ClearFormats
If FName <> "False" Then
Set W = Workbooks.Add
ThisWorkbook.Activate
Sheets("Compare").Copy before:=W.Sheets(1)
W.Activate
W.SaveAs FileName:=FName
W.Sheets("Compare").Cells.Locked = True
W.Worksheets("Compare").Protect Password:="xxxxx", userinterfaceonly:=True
End If

End Sub

 

[sofas]

Hi. Try this is what you mean

Sub export()

    Dim FName As String, DefaultName As String
    Dim W As Workbook
    Dim WS As Worksheet
    
    Set WS = ThisWorkbook.Worksheets("Compare")
    
    DefaultName = "Compare - " & WS.Range("A1").Value & ".xlsx"
    FName = Application.GetSaveAsFilename(InitialFileName:=DefaultName, filefilter:="Excel Files (*.xlsx), *.xlsx")
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    On Error Resume Next
    WS.Unprotect Password:="xxxx"
    On Error GoTo 0

    If FName <> "False" Then
        WS.Copy
        Set W = ActiveWorkbook
        
        W.Sheets(1).Range("A20:B30, A40:B50").ClearContents
        W.Sheets(1).Range("A20:B30, A40:B50").ClearFormats

        W.SaveAs Filename:=FName, FileFormat:=xlOpenXMLWorkbook
    End If

    WS.Protect Password:="xxxx", UserInterfaceOnly:=True

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub