CODEWITHSUNDEEP
excelvbaxls
Bildircin13
Bildircin13

Reputation: 113

Save a specific sheet as individual xls file with vba

I'm trying to write a vba code to save a specific worksheet as another workbook file. I want the user to be able to name the workbook file and path.

I tried different approaches but none of them worked.

If that's not possible, I'm ok with only saving to this location:

"Q:\Sorular\" Spesific filename is shown in codes.

Sub Soru_Publish()

Dim fName1 As String
fName1 = Worksheets("Storyboard").Range("E3").Value & "_" & Worksheets("Storyboard").Range("E2").Value

Worksheets("Soru_Publish").Visible = True
Worksheets("Soru_Publish_2").Visible = True
Worksheets("Soru_Publish").Activate

    Dim FirstBlankCell As Long, rngFound As Range

    With Sheets("Soru_Publish")
        Set rngFound = .Columns("A:A").Find("*", After:=.Range("A1"), _
            searchdirection:=xlPrevious, LookIn:=xlValues)
        If Not rngFound Is Nothing Then FirstBlankCell = rngFound.Row
    End With

Worksheets("Soru_Publish").Range("A1:Y" & FirstBlankCell & "").Copy
Worksheets("Soru_Publish_2").Range("A1:Y" & FirstBlankCell & "").PasteSpecial Paste:=xlPasteValues

Worksheets("Soru_Publish_2").Copy

With ActiveWorkbook
    .SaveAs filename:="Q:\Sorular\" & filename
    .Close
End With

Worksheets("Sorular").Activate
Worksheets("Sorular").Range("B4").Select

Worksheets("Soru_Publish").Visible = False
Worksheets("Soru_Publish_2").Visible = False

End Sub

Unfortunately when I run the macro, I get Run-time error '1004' at SaveAs line.

Upvotes: 1

Views: 4783

Answers (2)

Louis
Louis

Reputation: 3632

Your code works, but using ActiveWorkbook can give you unexpected results.

If you want to save a single sheet as a new .xls file, just use .SaveAs directly on the sheet you need to save, like this:

Dim wrkSheet As Worksheet
Set wrkSheet = Worksheets("Soru_Publish_2")
wrkSheet.SaveAs Filename:="Q:\Sorular\" & fName1

Or like this if you don't want to define a new variable:

Worksheets("Soru_Publish_2").SaveAs Filename:="Q:\Sorular\" & fName1

Hope this helps.

Upvotes: 1

Bildircin13
Bildircin13

Reputation: 113

Sorry, I forgot to change the " filename " to " fName1". Code works just fine, it was just a typo.

Upvotes: 0

Related Questions