Thread: Macro Loop Create Excel Files

Hello,

I have two columns of filepaths in excel. I would like to write a macro that will open the excel file listed in Column D (with a rowcounter) and save it as a new file with the name/path in Column E (same rowcounter). I would like to loop through the entire list of file paths to do this quickly.

Here is what I have so far. Can't seem to troubleshoot this though.

    Dim rowcounter As Integer
    Dim filepath As String
    Dim template_file As String
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("IAS")
    Dim xlapp As Excel.Application
       
    rowcounter = 3
       
    Do While Not IsEmpty(Sheets("IAS").Range("B" & rowcounter).Value)
       template_file = ws.Cells(rowcounter, 4).Value
       filepath = ws.Cells(rowcounter, 5).Value
       xlapp.Workbooks.Open Filename:=template_file
       ActiveWorkbook.SaveAs Filename:=filepath _
       , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
       ReadOnlyRecommended:=False, CreateBackup:=False
    rowcounter = rowcounter + 1
    Loop

Hello gsurge,

If all your files are on the same disk, you could use the Name As statement instead of opening and saving the files.

Hello gsurge,

In that case, the answer would be no. The file must already exist. You can iterate through range easier by using a Range variable that represents the cells with data. Here is an example.

    Dim filepath As String
    Dim Rng As Range
    Dim template_file As String
    Dim ws As Worksheet
    Dim xlapp As Excel.Application

    Set ws = ThisWorkbook.Worksheets("IAS")
        
    Set Rng = ws.Range("D3").End(xlDown)
    
    For each Cell In Rng
       template_file = Cell.Value
       filepath = Cell.Offset(0, 1)..Value
       xlapp.Workbooks.Open Filename:=template_file
       ActiveWorkbook.SaveAs Filename:=filepath _
       , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
       ReadOnlyRecommended:=False, CreateBackup:=False
    Next Cell

Hello gsurge,

I see the problem. My mistake there is a typo in the For Next loop. Here is the corrected code.

Also I added a check for the "\" character in the file path.

    For Each Cell In Rng
       template_file = Cell.Value
       filepath = Cell.Offset(0, 1).Value
       filepath = IIf(Right(filepath, 1) <> "\", filepath & "\", filepath)
       xlapp.Workbooks.Open Filename:=template_file
       ActiveWorkbook.SaveAs Filename:=filepath _
       , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
       ReadOnlyRecommended:=False, CreateBackup:=False
    Next Cell

Hello gsurge,

If you are running this macro outside of Excel then you need to set the variable xlapp to an instance of Excel. Here is an example.

    Set xlApp = CreateObject("Excel.Application")

If you are running the macro from inside Excel then simply delete the xlapp Dim statement and prefix from your code. It would look this...

    Dim filepath As String
    Dim Rng As Range
    Dim template_file As String
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Worksheets("IAS")
        
    Set Rng = ws.Range("D3").End(xlDown)


    For Each Cell In Rng
       template_file = Cell.Value
       filepath = Cell.Offset(0, 1).Value
       filepath = IIf(Right(filepath, 1) <> "\", filepath & "\", filepath)
       Workbooks.Open Filename:=template_file
       ActiveWorkbook.SaveAs Filename:=filepath _
       , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
       ReadOnlyRecommended:=False, CreateBackup:=False
    Next Cell

Hello gsurge,

When the errors occurs, you can move your cursor over the variables in the statement and VBA will show you what they contain. Check the file path is what you have on the sheet and that the path is corrected formatted.

Hello gsurge,

I set the macro to look down from the starting until it found a blank cell. Not the way I usually do it but I thought perhaps the data was all unbroken. This method ill find the cell in the column that contains data. The macro will need to skip blanks if they are encounterd. Try this macro and let me know.

    Dim filepath As String
    Dim Rng As Range
    Dim RngEnd As Range
    Dim template_file As String
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Worksheets("IAS")
        
    Set Rng = ws.Range("D3")
    Set RngEnd = ws.Cells(Rows.Count, Rng.Column).End(xlUp)
    If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = ws.Range(Rng, RngEnd)

    For Each Cell In Rng
      If Cell <> "" Then
         template_file = Cell.Value
         filepath = Cell.Offset(0, 1).Value
         filepath = IIf(Right(filepath, 1) <> "\", filepath & "\", filepath)
         Workbooks.Open Filename:=template_file
         ActiveWorkbook.SaveAs Filename:=filepath , FileFormat:=xlNormal, _ 
                               Password:="", WriteResPassword:="", _
                               ReadOnlyRecommended:=False, CreateBackup:=False
       End If
    Next Cell