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

vikishah

New Member
Joined
Oct 24, 2018
Messages
4
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

Active Member
Joined
Apr 23, 2012
Messages
280
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.

Code:
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

New Member
Joined
Oct 24, 2018
Messages
4
Thank you Nardagus. This saved me a whole lot of time. Appreciate he quick and correct response.
 

Forum statistics

Threads
1,081,622
Messages
5,360,079
Members
400,569
Latest member
tcormack

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top