• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Saving file to location written in particular cell

Anjamen

New Member
Hi everyone!
I'm trying to write a macro which will copy some sheet from one workbook and save it as a new workbook to location written on cell B14 in sheet "Uputstvo". For example, instead of saving it to location written in code, like I did, I want vba to look at cell B14 in sheet "Uputstvo" to see where to save a new file. My client doesn't know how to change location in vba code so I want to make easy for him to put the location of the folder where files will be saved in cell B14.


Sub kopiranje_baze_JELENA()

Sheets("TABELA").Select
Sheets("TABELA").Copy After:=Sheets(4)
Sheets("TABELA (2)").Select
Sheets("TABELA (2)").Name = "j"
Sheets("j").Select
Columns("V:BD").Select
Selection.Delete Shift:=xlToLeft
Sheets("j").Select
Application.DisplayAlerts = False
Sheets("j").Copy After:=Sheets(4)
Sheets("Jelena").Select
Range("A3").Select
ActiveWorkbook.RefreshAll
Sheets("Jelena").Select
Sheets("Jelena").Copy


ChDir "C:\Users\Nemanja\Desktop\Exel zadaci\STEFAN\MiLpOp\Milpop BM\jjjj"
ActiveWorkbook.SaveAs fileName:="C:\Users\Nemanja\Desktop\Exel zadaci\STEFAN\MiLpOp\Milpop BM\jjjj\Jelena.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False



ActiveWindow.Close
Sheets("j").Select
ActiveWindow.SelectedSheets.Delete
Sheets("j (2)").Select
ActiveWindow.SelectedSheets.Delete
Sheets("UPUTSTVO").Select

End Sub
 
You can store the file path into a variable, and then use it later. General code cleaining:

Code:
Sub kopiranje_baze_JELENA()
    Dim strName As String
   
    'Assuming full file path
    strName = Worksheets("Uputstvo").Range("B14").Value
   
    'Error check
    If Right(strName, 1) <> Application.PathSeparator Then
        strName = strName & Application.PathSeparator
    End If
   
    Application.ScreenUpdating = False
    Sheets("TABELA").Copy After:=Sheets(4)
    Sheets("TABELA (2)").Name = "j"
   
    Worksheets("j").Columns("V:BD").Delete Shift:=xlToLeft
   
   
    Worksheets("j").Copy After:=Sheets(4)
   
    ActiveWorkbook.RefreshAll
   
    Sheets("Jelena").Copy
   
   
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=strpath & "Jelena.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
   
    ActiveWorkbook.Close
    Sheets("j").Delete
    Sheets("j (2)").Delete
    Application.DisplayAlerts = True
   
    Sheets("UPUTSTVO").Select
    Application.ScreenUpdating = True
End Sub
 
Back
Top