Macro to open multiple files in a folder and copy 'all' values from a column and paste it in a master file

[vikishah]

Hello,
I have two folders with multiple files (daily SAP users). I need to open each and every file and copy values from col. C and paste it in a master file in col. A. The values from the next file (col. C) need to be copied in Master file (col. A) in the first empty cell, and continue till values of col. C from all files are pasted in col. A of the master file.
Please help!!
Thank you.

 

[nardagus]

Hello,

You didn't say if:

- data in source files starts from row 2 (I took it as yes)
- a name of a sheet in source files (I left Sheet1, so change it if you need)
- a name of a sheet in master file (I name my master sheet as... master. Change it if you need)

Paste macro code in a module and run it.
Macro works as follows:

1) It sets some variables in a background
2) Shows a dialog to pick a folder to process files from
3) Transfers data from every source file to a master workbook
4) Calls this macro again. It will keep calling macro in a loop until you click Cancel in a dialog box.

Hope this helps.

Sub copy_data()


Dim fpath As String
Dim shname As String
Dim fext As String
Dim ftc As String 'File To Copy
Dim wb As Workbook
Dim mfile As Workbook 'masterfile
Dim msheet As String 'master sheet of master file
Dim lrm As Long 'last row of master file
Dim lrc As Long 'last row of file to copy
Dim FPicker As FileDialog


'disable some stuff to speed things up
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual


'set master file
Set mfile = ActiveWorkbook


'set master sheet > change to your master sheet name. Don't remove quotes.
msheet = "master"


'sheet name of source file to be copied > change to your source sheet name. Don't remove quotes.
shname = "Sheet1"


'find last row with data
With mfile.Worksheets(msheet)
    lrm = .Range("A" & Rows.Count).End(xlUp).Row
End With


'get files-to-copy
Set FPicker = Application.FileDialog(msoFileDialogFolderPicker)


With FPicker
    .Title = "Select Source Folder"
    .AllowMultiSelect = False
    If .Show = 0 Then Exit Sub
    fpath = .SelectedItems(1) & "\"
End With


'pick all excel files in a chosen folder
fext = "*.xls*"


'file to process
ftc = Dir(fpath & fext)


Do While ftc <> ""
    Set wb = Workbooks.Open(Filename:=fpath & ftc)
    
    'copy from row 2 to last row with data
    With wb.Worksheets(shname)
        lrc = .Range("C" & Rows.Count).End(xlUp).Row
        With .Range("C2:C" & lrc)
            .Select
            .Copy
        End With
    End With
    'get last row of data in master file and paste
    With mfile.Worksheets(msheet)
        lrm = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A" & lrm + 1).PasteSpecial (xlPasteAll)
    End With
    
    'close source workbook
    wb.Close SaveChanges:=False
    'pick next file to copy
    ftc = Dir
Loop


'restore settings preMacro
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True

'Call this macro again, and again, and again until user clicks Cancel in a dialog box
Call copy_data
End Sub

 

[vikishah]

Thank you Nardagus. This saved me a whole lot of time. Appreciate he quick and correct response.