View Single Post
 
Old 03-12-2019, 08:25 AM
NoSparks NoSparks is offline Windows 7 64bit Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 842
NoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of light
Default

Maybe this
Code:
Sub Create_Workbook_From_Template_and_Save()

    Dim rng As Range, cel As Range
    Dim Flname As String
    Dim FlLink As String
    Dim Rev As String
    Dim Title As String
    Dim Subcontractor As String

Set rng = Workbooks("CRS Data Input").Worksheets("Data").ListObjects("Table_query").ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible)

For Each cel In rng
    Flname = cel.Value
    FlLink = cel.Hyperlinks(1).Address
    Rev = cel.Offset(, 4).Value
    Title = cel.Offset(, 3).Value
    Subcontractor = cel.Offset(, 7).Value

    'Open new workbook from template
    Workbooks.Open FileName:=ThisWorkbook.Path & "\CRS Template.xlsx", Editable:=False
    
    'Copy data from data sheet to template
    Workbooks("CRS Template").Worksheets("CRS").Range("K1").Hyperlinks.Add Anchor:=Range("K1"), Address:=FlLink, TextToDisplay:=Flname
    Workbooks("CRS Template").Worksheets("CRS").Range("N1") = Rev
    Workbooks("CRS Template").Worksheets("CRS").Range("K2") = Title
    Workbooks("CRS Template").Worksheets("CRS").Range("K3") = Subcontractor
    
    'Save template in Output folder with custom filename
    Workbooks("CRS Template").Close SaveChanges:=True, FileName:=ThisWorkbook.Path & "\Output\" & Flname & "-CRS.xlsx"
Next cel

End Sub
Reply With Quote