Vb to Save a new workbook in the same location

[bark01]

Hi,

I have a script that takes a sheet from the current workbook puts it into a new workbook then converts all the data into values and then saves it as a specific name.

It currently saves the new workbook to the 'my documents' folder but I want to save it in the same location as the workbook which contained the original macro.

how do I do this?

Sub ZCRM()
Dim Fname As String
Fname = Sheets("ZCRM_PROD_SELECT").Range("A1").Value
Sheets("ZCRM_PROD_SELECT").Copy
With ActiveWorkbook
Range("A1:k3000").Select

Selection.Copy
Range("a1").Select

Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Range("A1").Select

Application.CutCopyMode = False

    .SaveAs Filename:="ZCRM.xls"
    .Close
End With
End Sub

many thanks

 

[Sektor]

Sub ZCRM()
    Dim Fname As String
    Fname = Sheets("ZCRM_PROD_SELECT").Range("A1").Value
    Sheets("ZCRM_PROD_SELECT").Copy
    With ActiveWorkbook
    Range("A1:k3000").Select
    
    Selection.Copy
    Range("a1").Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    Range("A1").Select
    
    Application.CutCopyMode = False
    
        .SaveAs Filename:=[B]ThisWorkbook.Path & "\ZCRM.xls"[/B]
        .Close
    End With
End Sub

 

[bark01]

Thanks for the rapid response, I've got a similar problem with another piece of code. I need the .csv created by this saved in the same folder so guess I need to add [ThisWorkbook.Path] somewhere, I've tried a few combinations but can't get it to work.

Sub mysaver()
Application.Calculation = xlManual
Dim counter As Integer
counter = 9
' counter is for the number of sheets in the workbook
Do While counter <= Worksheets.Count
' Worksheets.Count represents the total number of sheets in the workbook
On Error GoTo ErrorHandler
' go to the nominated sheet
Worksheets(counter).Activate
' and save it. Simple...
ActiveSheet.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV
counter = counter + 1
Loop
MsgBox "All Sheets Saved.", , "Success"
Exit Sub

ErrorHandler:
MsgBox "Error during save - Caution!", vbCritical, "Save Errors"
Exit Sub
Application.Calculation = xlAutomatic
End Sub

I'm guessing I need to add something into here

ActiveSheet.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV

 

[Sektor]

ActiveSheet.SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Name, FileFormat:=xlCSV

 

[bark01]

спасибо