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

delaney1102

New Member
Joined
Aug 14, 2019
Messages
15
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
 
Hi. Try this is what you mean

VBA Code:
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
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top