How to create a VBA macro that will copy data from multiple source workbooks within a folder to another workbook thereafter saving as a new workbook

Question

Just abit more context on what I require help with. I need to create a VBA macro that will copy a specific row from a worksheet and paste it into another workbook sheet. Thereafter saving the file as a new workbook. I need to ensure that this VBA is an array, meaning that this will need to be done on many workbooks in a folder. That is. For each source workbook copy the row of data, paste it in the master workbook and save the workbook as a new workbook. that being said I would require 10 master workbooks as there are 10 source workbooks.

This is where my workbooks reside

This is the sample of a source workbook file as shown below. I need to copy just the data without headers so row 2. This needs to be done for all files within the folder above. All file have the same layout with just row 2 as where the data resides.

The master/destination workbook is shown below and the row that data should be pasted in is row 9. This templated workbook resides in a different folder.

Below is the code i use that currently adds the rows of data from multiple workbooks within the source folder to the master workbook, however this increments the rows. I need help with how to create a new master workbook for each source workbook and thereafter save the master workbook with a source workbook name as a suffix Example "Master workbook-AAAA".xlsx

Option Explicit
Const FOLDER_PATH = "C:\Users\\Desktop\Split Files\"  'REMEMBER END BACKSLASH'

Sub ImportWorksheets()
'Process all Excel files in specified folder'
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row

       rowTarget = 9

       'check the folder exists    
      If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub   
      End If

       'reset application settings in event of error'    
        On Error GoTo errHandler    
       Application.ScreenUpdating = False

       'set up the target worksheet'    
       Set wsTarget = Sheets("DATABASE")

       'loop through the Excel files in the folder'    
       sFile = Dir(FOLDER_PATH & "*.xls*")    
       Do Until sFile = ""
      
      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets(1)
      
      'import the data'
      With wsTarget
         .Range("A" & rowTarget).Value = wsSource.Range("A2").Value
         .Range("B" & rowTarget).Value = wsSource.Range("B2").Value
         .Range("C" & rowTarget).Value = wsSource.Range("C2").Value
         .Range("D" & rowTarget).Value = wsSource.Range("D2").Value
         .Range("E" & rowTarget).Value = wsSource.Range("E2").Value
         .Range("F" & rowTarget).Value = wsSource.Range("F2").Value
         .Range("G" & rowTarget).Value = wsSource.Range("G2").Value
         .Range("H" & rowTarget).Value = wsSource.Range("H2").Value
         .Range("I" & rowTarget).Value = wsSource.Range("I2").Value
      End With
      
      'close the source workbook, increment the output row and get the next file'
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()    
      Loop

    errHandler:    
    On Error Resume Next   
    Application.ScreenUpdating = True

       'tidy up'    
         Set wsSource = Nothing    
         Set wbSource = Nothing     
         Set wsTarget = Nothing 
       End Sub

Private Function FileFolderExists(strPath As String) As Boolean If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True End Function

The result is shown below

Just an update..

I tried a different approach as shown below. However the workbook is crashing. Any idea what am i doing wrong ?

You need to (1) list all the workbooks in a folder, (2) open a workbook, (3) find a particular worksheet in a workbook, (4) find a particular row in a worksheet, (5) copy a row from one worksheet to a worksheet in another workbook, (6) save the other workbook. Which piece are you having problems with? — Nicholas Hunter
Hi Nicholas. Im having problems with (5) and (6). So currently i can save data from row 2 for all the source workbooks thats located in a folder to the master workbook row 9. But thats not the solution i need as the code i have increments it in 1 master workbook. The solution i need is to create a loop that will copy row 2 from the source workbook and paste it in row 9 of the master workbook thereafter saving it as a new workbook x 10 as there are 10 source workbooks. — coder
I assume you want to create the new master workbooks from the template, correct ? Where are the new workbooks to be saved to ? — CDP1802
Hi there. Yes i want to create the new master workbooks from the template. The new workbooks need to be saved in a new folder on my desktop. — coder

CDP1802 CDP1802 · Accepted Answer · 2021-04-10T07:43:22

 'open template
    Const MASTER = "path-to-file\master.xlsx"
    Set wbTarget = Workbooks.Open(MASTER)
    Set wsTarget = wbTarget.Sheets(1)
    wsTarget.Unprotect "password"

    Do While sFile <> ""

        ' read source
        Set wbSource = Workbooks.Open(sFolder & sFile, 1, 1) ' update links, readonly
        Set wsSource = wbSource.Sheets(1)

        ' create target
        wsTarget.Name = "DATABASE"
        wsTarget.Range("A" & ROW_TARGET).Resize(1, 9) = wsSource.Range("A2:I2").Value2
        wbTarget.SaveAs "path\to\Master_" & sFile
        wbSource.Close False
    
        sFile = Dir

    Loop
    wsTarget.protect "password"
    wbTarget.Close False

How to create a VBA macro that will copy data from multiple source workbooks within a folder to another workbook thereafter saving as a new workbook

1 Answers