Save file as cell reference from another sheet

[Leigh Metcalfe]

Hi,

I need help with saving the below code, . need to replace .SaveAs "Z:\AutocadDraw\Script.scr", xlTextPrinter with a cell reference from the workbook it copied the sheet from.

The name of workbook I need the name of the file and directory is called "autocad creator new.xlsb"

Sheet is called "autocad creator" cell ref = M9 for file name required
Sheet is called "autocad creator" cell ref = M10 for file save directory required

Sub Notepad()
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic
Sheets("Program").Select
Dim Rng As Range
Dim wb As Workbook
Set Rng = Range("a1:a8000").SpecialCells(xlCellTypeVisible)
Set wb = Workbooks.Add
With wb
Rng.Copy
.Worksheets(1).Range("a1:a8000").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With Selection
.HorizontalAlignment = xlLeft
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.SaveAs "Z:\AutocadDraw\Script.scr", xlTextPrinter
.Close False
Program.Visible = False
Application.Calculation = xlCalculationManual
End With
End Sub

----------------------------------------------------------------------------
Mod Edit: Code Tags added

 

[Debaser]

Try something like this:

Sub Notepad()
    Dim Rng                   As Range
    Dim wb                    As Workbook
    Dim sFolder               As String
    Dim sFile                 As String

    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationAutomatic
    Sheets("Program").Select
    Set Rng = Range("a1:a8000").SpecialCells(xlCellTypeVisible)

    With ActiveWorkbook.Worksheets("autocad creator")
        sFile = .Range("M9").Value
        sFolder = .Range("M10").Value
    End With

    Set wb = Workbooks.Add

    With wb
        Rng.Copy
        .Worksheets(1).Range("a1:a8000").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                                      SkipBlanks:=False, Transpose:=False
        With Selection
            .HorizontalAlignment = xlLeft
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        .SaveAs "Z:\" & sFolder & "\" & sFile, xlTextPrinter
        .Close False
        Sheets("Program").Visible = False
        Application.Calculation = xlCalculationManual
    End With
End Sub

 

[Leigh Metcalfe]

Works Perfect.

Thanks Debaser.