Excel VBA - Loop copy data from X input workbooks and saving X output workbooks

RoflMayo

New Member
Joined
Mar 6, 2023
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hi guys,
Very new to writing macros, I'm trying to automate the copy/paste/save of input and output data but I keep locking myself out of my Calculations workbook in the process :cry:!
Context: I have the parent folder directory "...\Macro Test\" which contains 2 folders "Input" and "Output" and 1 workbook "Test Spreadsheet 3.xlsx". "Test Spreadsheet 3.xlsx" contains calculations and transforms the input data.
In the "Input" folder are X workbooks containing raw data and the "Output" folder is empty.
I've been trying to write a macro that does the following steps:

1. Makes a copy of "Test Spreadsheet 3.xlsx" from the parent directory ("...\Macro Test\") to the "Output" folder (turn animations off)
2. Open the first workbook in the "Input" folder (turn autosave off)
3. Copy columns A:K from the first worksheet of the first input workbook (from step 2.)
4. Paste (from step 3.) as value into cell A1 of the first worksheet of "Test Spreadsheet 3.xlsx" workbook (from step 1.) (turn autosave off) Note, the first worksheet of "Test Spreadsheet 3.xlsx" has conditional formatting that I do not wish to override
5. Save "Test Spreadsheet 3.xlsx" (from step 1.) and rename it as the input workbook (from step 2.) &"-Checks" and close
6. Close the input workbook (from step 2.), do not save any changes
7. Loop steps 1 to 6 for all other '.xlsx' in the "Input" folder
8. Turn animations back on and output msgbox saying "Done!"

If anyone could help me understand the steps in VBA, it'd be greatly appreciated.
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Most of your steps could be done by recording a macro to do steps 1-6 for one of the .xlsx files in the "Input" folder. Then edit the code to define strings for the "Input" and "Output" folders and add a Dir function loop to loop through the .xlsx files.

Also, rather than the copy and rename in steps 1 and 5, and repeating step 1 for each input .xlsx file, the macro could open "...\Macro Test\Test Spreadsheet 3.xlsx" once and Save Copy As "...\Macro Test\Output\xxxxx-Checks.xlsx".
 
Upvote 0
Most of your steps could be done by recording a macro to do steps 1-6 for one of the .xlsx files in the "Input" folder. Then edit the code to define strings for the "Input" and "Output" folders and add a Dir function loop to loop through the .xlsx files.

Also, rather than the copy and rename in steps 1 and 5, and repeating step 1 for each input .xlsx file, the macro could open "...\Macro Test\Test Spreadsheet 3.xlsx" once and Save Copy As "...\Macro Test\Output\xxxxx-Checks.xlsx".

Hi John, thanks for your response.
I had a go and, though I know my code is probably not optimal, I got it to work successfully the first time; however, all subsequent attempts resulted in an error somewhere later in the loop iterations.
I don't really know how to bug test as it's only been less than a week since I've started learning VBA. I keep "Test Spreadsheet 3 - Macro Text.xlsx" open when running the code.
Would really appreciate if you could point to areas of the code which could be done better.

VBA Code:
Sub Copy_Paste_Save()

Application.ScreenUpdating = False

Dim inputPath As String
inputPath = "...\Macro Test\Input\"
Dim outputPath As String
outputPath = "...\Macro Test\Output\"
Dim calcWb As Workbook
Set calcWb = Workbooks("Test Spreadsheet 3 - Macro Test.xlsx")
Dim appExcel As Excel.Application
Set appExcel = New Excel.Application
appExcel.DisplayAlerts = False
Dim wbSource As Excel.Workbook
Dim newName As String

Dim wbName As String
wbName = Dir(inputPath & "*.xlsx")
Do While wbName <> ""
    Set wbSource = appExcel.Workbooks.Open(inputPath & wbName)
        calcWb.Worksheets("Data").Range("A:K").ClearContents
        wbSource.Worksheets(1).Columns("A:K").Copy
        calcWb.Worksheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues
        wbSource.Activate
        SendKeys ("{ESC}")
               
        newName = Left(wbName, Len(wbName) - 5) & "-Calc.xlsx"
        calcWb.SaveCopyAs (outputPath & newName)
        wbSource.Close SaveChanges:=False
        Set wbSource = Nothing
        wbName = Dir()
Loop
appExcel.Quit
Set appExcel = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub
 
Upvote 0
That is a very good first attempt. You only need the appExcel Excel.Application object if the code is running from another Office application (e.g. Word) and you want to interact with Excel as an 'external' application. In this case, the code is running in Excel, so the Workbooks object is a member of the running Excel instance and the appExcel application object isn't needed.

See if this macro works for you:
VBA Code:
Public Sub Create_Output_Workbooks()

    Dim parentPath As String, inputPath As String, outputPath As String
    Dim calcWb As Workbook, inputWb As Workbook
    Dim inputXlsx As String
    
    parentPath = "C:\path\to\parent\folder\"    'CHANGE THIS
    inputPath = parentPath & "Input\"
    outputPath = parentPath & "Output\"
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    inputXlsx = Dir(inputPath & "*.xlsx")
    Do While inputXlsx <> vbNullString
        Set calcWb = Workbooks.Open(parentPath & "Test Spreadsheet 3.xlsx")
        Set inputWb = Workbooks.Open(inputPath & inputXlsx)
        inputWb.Worksheets(1).Columns("A:K").Copy
        calcWb.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
        calcWb.SaveCopyAs outputPath & Replace(inputWb.Name, ".xlsx", "-Checks.xlsx", Compare:=vbTextCompare)
        inputWb.Close SaveChanges:=False
        calcWb.Close SaveChanges:=False
        inputXlsx = Dir()
    Loop

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Done!"

End Sub
 
Upvote 0
Solution
That is a very good first attempt. You only need the appExcel Excel.Application object if the code is running from another Office application (e.g. Word) and you want to interact with Excel as an 'external' application. In this case, the code is running in Excel, so the Workbooks object is a member of the running Excel instance and the appExcel application object isn't needed.

See if this macro works for you:
VBA Code:
Public Sub Create_Output_Workbooks()

    Dim parentPath As String, inputPath As String, outputPath As String
    Dim calcWb As Workbook, inputWb As Workbook
    Dim inputXlsx As String
   
    parentPath = "C:\path\to\parent\folder\"    'CHANGE THIS
    inputPath = parentPath & "Input\"
    outputPath = parentPath & "Output\"
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    inputXlsx = Dir(inputPath & "*.xlsx")
    Do While inputXlsx <> vbNullString
        Set calcWb = Workbooks.Open(parentPath & "Test Spreadsheet 3.xlsx")
        Set inputWb = Workbooks.Open(inputPath & inputXlsx)
        inputWb.Worksheets(1).Columns("A:K").Copy
        calcWb.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
        calcWb.SaveCopyAs outputPath & Replace(inputWb.Name, ".xlsx", "-Checks.xlsx", Compare:=vbTextCompare)
        inputWb.Close SaveChanges:=False
        calcWb.Close SaveChanges:=False
        inputXlsx = Dir()
    Loop

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    MsgBox "Done!"

End Sub
Works like a charm! Thanks so much John.
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top