How do I have a Macro loop through a folder and copy data from one Excel workbook to another and save as a new name?

Question

I have a file called !PaymentTemplate.xlsx and a folder called "Output" with many files. I would like to loop through each of the files in the Output folder and copy data into the !PaymentTemplate.xlsx file and then save that template file. I do not want to append the data, just copy and paste it over and then save that file as a new name and then start over again from the original !PaymentTemplate.xlsx file. Example: A file in the Output folder called "Sunrise.xlsx", the macro should open it, copy the data into !PaymentTemplate.xlsx and save as Sunrise_New.xlsx. Then move on to the next file and do the same thing in the !PaymentTemplate.xlsx file.

If I have 10 files in the Output Directory, there should be 10 new files made with "_New" as part of the file name.

Below is a Macro I have written but am having trouble getting the fileName variable to be part of the Save As Export and testing it.

Sub Energy_Template()

'Loop through all files in a folder
Dim fileName As Variant
fileName = Dir("C:\Dan\Energy Commission\raw data\TEmplate for Upload\Output\")

While fileName <> ""
    Workbooks.Open fileName:= _
        "C:\Dan\Energy Commission\raw data\TEmplate for Upload\!PaymentTemplate.xlsx"
    Workbooks.Open fileName
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("!PaymentTemplate.xlsx").Activate
    Range("A3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ChDir "C:\Dan\Energy Commission\raw data\TEmplate for Upload\new ouput"
    ActiveWorkbook.SaveAs fileName:= _
        "C:\Dan\Energy Commission\raw data\TEmplate for Upload\new ouput\Sunrise_New.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    ActiveWindow.Close
    
    'Set the fileName to the next file
    fileName = Dir
Wend

End Sub

Thanks!

Unrelated to your question but you will benefit greatly from reading on [How to avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — Raymond Wu, Aug 04 '21 at 14:33

score 0 · Accepted Answer · answered Aug 04 '21 at 15:30

0

Try this code:

Sub Energy_Template()        
    Const outputFolderPath As String = "C:\Dan\Energy Commission\raw data\TEmplate for Upload\Output"
    Const templateFilePath As String = "C:\Dan\Energy Commission\raw data\TEmplate for Upload\!PaymentTemplate.xlsx"
    
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim loopFile As Object
    For Each loopFile In FSO.GetFolder(outputFolderPath).Files
        If FSO.GetExtensionName(loopFile.Name) = "xlsx" And Left$(loopFile.Name, 2) <> "~$" Then
            Dim outputWB As Workbook
            Set outputWB = Application.Workbooks.Open(loopFile.Path)
            
            Dim templateWB As Workbook
            Set templateWB = Application.Workbooks.Open(templateFilePath)
            
            Dim copyRng As Range
            Dim copyLastRow As Long
            copyLastRow = outputWB.Worksheets(1).Range("A2").End(xlDown).Row
            Set copyRng = outputWB.Worksheets(1).Range("A2:A" & copyLastRow).EntireRow
            copyRng.Copy
            templateWB.Worksheets(1).Range("3:3").Insert xlShiftDown
            
            Dim saveName As String
            saveName = Replace(outputWB.Name, ".", "_New.")
            Application.DisplayAlerts = False
            templateWB.SaveAs outputFolderPath & "\" & saveName
            
            templateWB.Close
            Set templateWB = Nothing
            
            outputWB.Close 0
            Set outputWB = Nothing
            Application.DisplayAlerts = True
        End If
    Next loopFile
End Sub

answered Aug 04 '21 at 15:30

Raymond Wu

3,357
2
7
20

Thanks! I get a run time error: Run-time error '1004': Insert method of Range class failed -- templateWB.Worksheets(1).Range("3:3").Insert xlShiftDown – Shmelky Aug 04 '21 at 15:51
Can you share a screenshot of the area that you want to paste into? The !PaymentTemplate file – Raymond Wu Aug 04 '21 at 15:58
So I would be copying data from row 2 all the way to the end (number of records could could be different for each file). I would be pasting that data starting in row 3 in the TemplateFile. – Shmelky Aug 04 '21 at 16:04
@shmelky I understand that, can you step through the code and check the `Address` of `copyRng` before it copy? You can insert a line `Debug.Print copyRng.Address just above `copyRng.copy` and verify if the address in the immediate window is what you want to copy from `outputWB` – Raymond Wu Aug 04 '21 at 16:10
I ran the code line by line using F8. I see it opens the first file in the folder and copies the correct range – Shmelky Aug 04 '21 at 16:32
@Shmelky So the error only occured on some file, continue to run through until you get that error then you need to check what's different about it. – Raymond Wu Aug 04 '21 at 16:41
I think I figured out the problem. The Template file is protected from Inserting rows. The data needs to be a straight Copy. Can you help with updating that line :) Thank you – Shmelky Aug 04 '21 at 16:58
Can't you unprotect it? Do you have the password? It's late here so I won't be doing that until like 10hours later – Raymond Wu Aug 04 '21 at 17:01
It's not my file so I can't unprotect it – Shmelky Aug 04 '21 at 17:02
I need more info, Is the amount of column to be copied over fixed? I.e. whats the range in columns – Raymond Wu Aug 04 '21 at 17:05
1

I figured it out. I changed "templateWB.Worksheets(1).Range("3:3").Insert xlShiftDown" to "copyRng.Copy templateWB.Worksheets(1).Range("3:3")" and it copies over perfectly – Shmelky Aug 04 '21 at 17:10

How do I have a Macro loop through a folder and copy data from one Excel workbook to another and save as a new name?

1 Answers1