Forum Discussion

JoAvg's avatar
JoAvg
Brass Contributor
Jan 20, 2023
Solved

Macro - Help defining range from two worksheets

I have a macro that creates a "station.xlsx" file inside a given folder in

Desktop\AsBuilt\Date\City\Address

 

I need to modify the macro so that:

1. The copied range is derived from STASH!A53:I54

2. sCity value is derived from sheet FORMULAS!B42

3. sAdress value is derived from FORMULAS!B43

 

Thank you

 

Sub Create_Station()
    Dim wbkT As Workbook
    Dim wshS As Worksheet
    Dim wshT As Worksheet
    Dim sPath As String
    Dim sDate As String
    Dim sCity As String
    Dim sAddress As String
    Dim sFile As String
    Set wshS = ThisWorkbook.Worksheets("FORMULAS")
    Set wbkT = Workbooks.Add(xlWBATWorksheet)
    Set wshT = wbkT.Worksheets(1)
    wshS.Range("A53:I54").Copy
    wshT.Range("A1").PasteSpecial Paste:=xlPasteValues
    wshT.Range("A1").PasteSpecial Paste:=xlPasteFormats
    sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    sDate = Format(Date, "dd mm yyyy")
    sPath = sPath & "\ASBUILT\" & sDate
    sCity = wshS.Range("A5").Value
    sPath = sPath & "\" & sCity
    sAddress = wshS.Range("A20").Value
    sPath = sPath & "\" & sAddress
    sFile = "STATION.xlsx"
    sPath = sPath & "\" & sFile
    wbkT.SaveAs Filename:=sPath, FileFormat:=xlOpenXMLWorkbook
    wbkT.Close
End Sub

 

excel
Macros and VBA
office 365
  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Jan 20, 2023

    JoAvg 

    Does this work as desired?

     

    Sub Create_Station()
    Dim wbkT        As Workbook
    Dim wsStash     As Worksheet
    Dim wsFormulas  As Worksheet
    Dim wshS        As Worksheet
    Dim wshT        As Worksheet
    Dim sPath       As String
    Dim sDate       As String
    Dim sCity       As String
    Dim sAddress    As String
    Dim sFile       As String
    
    Application.ScreenUpdating = False
    
    Set wsStash = ThisWorkbook.Worksheets("STASH")
    Set wsFormulas = ThisWorkbook.Worksheets("FORMULAS")
    Set wbkT = Workbooks.Add(xlWBATWorksheet)
    Set wshT = wbkT.Worksheets(1)
    wsStash.Range("A53:I54").Copy
    wshT.Range("A1").PasteSpecial Paste:=xlPasteValues
    wshT.Range("A1").PasteSpecial Paste:=xlPasteFormats
    sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    sDate = Format(Date, "dd mm yyyy")
    sPath = sPath & "\ASBUILT\" & sDate
    sCity = wsFormulas.Range("B42").Value
    sPath = sPath & "\" & sCity
    sAddress = wsFormulas.Range("B43").Value
    sPath = sPath & "\" & sAddress
    sFile = "STATION.xlsx"
    sPath = sPath & "\" & sFile
    wbkT.SaveAs Filename:=sPath, FileFormat:=xlOpenXMLWorkbook
    wbkT.Close
    Application.ScreenUpdating = True
End Sub
  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Silver Contributor
    Jan 20, 2023

    JoAvg 

    Does this work as desired?

     

    Sub Create_Station()
    Dim wbkT        As Workbook
    Dim wsStash     As Worksheet
    Dim wsFormulas  As Worksheet
    Dim wshS        As Worksheet
    Dim wshT        As Worksheet
    Dim sPath       As String
    Dim sDate       As String
    Dim sCity       As String
    Dim sAddress    As String
    Dim sFile       As String
    
    Application.ScreenUpdating = False
    
    Set wsStash = ThisWorkbook.Worksheets("STASH")
    Set wsFormulas = ThisWorkbook.Worksheets("FORMULAS")
    Set wbkT = Workbooks.Add(xlWBATWorksheet)
    Set wshT = wbkT.Worksheets(1)
    wsStash.Range("A53:I54").Copy
    wshT.Range("A1").PasteSpecial Paste:=xlPasteValues
    wshT.Range("A1").PasteSpecial Paste:=xlPasteFormats
    sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    sDate = Format(Date, "dd mm yyyy")
    sPath = sPath & "\ASBUILT\" & sDate
    sCity = wsFormulas.Range("B42").Value
    sPath = sPath & "\" & sCity
    sAddress = wsFormulas.Range("B43").Value
    sPath = sPath & "\" & sAddress
    sFile = "STATION.xlsx"
    sPath = sPath & "\" & sFile
    wbkT.SaveAs Filename:=sPath, FileFormat:=xlOpenXMLWorkbook
    wbkT.Close
    Application.ScreenUpdating = True
End Sub

Resources