Macro - Merge all files into one sheet

M

Misono

New Member
Joined
Dec 2, 2016
Messages
9
Can someone help me with the VBA for this, as I don't really use it at all but think it'll be the best route. Situation:

- I have approx 60 .csv files within a folder containing multiple rows of data. All headings are the same in each file.
- I want to merge all of these into one document via a macro that has a master sheet, then loops through the folder and adds in the data from each individual file before closing it.

I figured as part of this, and so that I could adapt this for future issues as I expect I'll come across it again, I could do so by putting the filepath for the Master Sheet in Cell A3, The filename for the master sheet in A4, and the folder to loop through in A5. That way, I could then use this macro for other groups if ever needed.

I tried running this with Gemini, but couldn't get it to fix the issue with prompts.

This is for Excel 365, and the file locations will be via Sharepoint initially.

Thanks!
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
try this... run the macro macro12_run_all_copy_paste_files_ you must manually enter your folder path in cell A3 in the sheet ListFiles, like c:\temp2\6489\. Please note this very important assumption in Macro31.'''really important here. assumes column A is ALWAYS filled with data. If a cell in column A does not have data, this will overwrite the data in B to XFC. '''assume the following. 1)you have all the csv files in this folder C:\temp2\6489 2)The master file is named Master.xlsm inside are two sheets ListFiles, and MasterSheet 3) ListFiles is where all the csv files are listed. 4) MasterSheet is where all the data will be copied to. 5) When copying, will not copy row1, as row1 is assumed to be the header. Cheers!

VBA Code: 
'This function loops through all the files in the folder and gets the properties of each file and displays them on the sheet
Public Sub Now_GetFileProperties()
    'Variable Declaration
    Dim objFS As Object
    Dim objFile As Object
    Dim strPath As String
    Dim vFile As Variant
    Dim iCurRow As Integer
    'Clear old data from the sheet
''    Sheet1.Range("C7:H" & Sheet1.Rows.Count).ClearContents
    'Set the path of the folder based on cell A3
    strPath = ActiveSheet.Range("A3").Value
' ====> manually set the path below    strPath = "c:\temp2\6489\"
    'Add slash at the end of the path
    If Right(strPath, 1) <> "/" And Right(strPath, 1) <> "" Then
        strPath = strPath & ""
    End If
    'Set Directory to folder path
    ChDir strPath
    vFile = Dir(strPath & "*.*") 'Change or add formats to get specific file types
    'Set the variable to FileSystemObject
    Set objFS = CreateObject("Scripting.FileSystemObject")
    iCurRow = 7
    Do While vFile <> "" 'LOOP until all files in folder strPath have been looped through
        Set objFile = objFS.GetFile(vFile)
        'File name
        ActiveSheet.Cells(iCurRow, 3).Value = objFile.Name
        'Date Created
        ActiveSheet.Cells(iCurRow, 4).Value = objFile.DateCreated
        'Date Last Accessed
        ActiveSheet.Cells(iCurRow, 5).Value = objFile.DateLastAccessed
        'Date Last Modified
        ActiveSheet.Cells(iCurRow, 6).Value = objFile.DateLastModified
        'Size
        ActiveSheet.Cells(iCurRow, 7).Value = Round(objFile.Size / 1024 / 1024, 2)
        'Type
        ActiveSheet.Cells(iCurRow, 8).Value = objFile.Type
        vFile = Dir
        iCurRow = iCurRow + 1
    Loop
End Sub


Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)

'Declaring variables
Dim FSO As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Dim r As Long
   
'Creating object of FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)

r = Range("A1048574").End(xlUp).Row + 1

For Each FileItem In SourceFolder.Files

    'Display file properties
     Cells(r, 1).Formula = FileItem.Name
     Cells(r, 2).Formula = FileItem.Path
     Cells(r, 3).Formula = FileItem.Size
     Cells(r, 4).Formula = FileItem.DateCreated
     Cells(r, 5).Formula = FileItem.DateLastModified
     
     r = r + 1
     
Next FileItem

'Getting files in sub folders
If IncludeSubfolders Then
     For Each SubFolder In SourceFolder.SubFolders
        'Calling same procedure for sub folders
        ListFilesInFolder SubFolder.Path, True
     Next SubFolder
End If

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

ActiveWorkbook.Saved = True

'''go to the sheet ListFiles
    Sheets("ListFiles").Select
    Application.Goto Reference:="R1C1"


End Sub



'''assume the following.  you have all the csv files in this folder C:\temp2\6489
''' the master file is named Master.xlsm  inside are two sheets  ListFiles, and MasterSheet
''' ListFiles is where all the csv files are listed.
''' MasterSheet is where all the data will be copied to.
''' When copying, will not copy row1, as row1 is assumed to be the header
Sub macro12_run_all_copy_paste_files_()
    Application.DisplayAlerts = False
    Application.Run " Macro18"
    Application.Run " Macro20"
    Application.Run " Macro21"
    Application.Run " Macro22"
    Application.Run " Macro23"

    Sheets("ListFiles").Select
    Application.Goto Reference:="R1C1"
    Application.Goto Reference:="R1C2"

For i = 1 To Range("a2")
    Application.Run " Macro29"
    Application.Run " Macro30"
    Application.Run " Macro31"
Next
End Sub


Sub Macro18()
'
'''go to the sheet ListFiles
    Windows("Master.xlsm").Activate
    Sheets("ListFiles").Select
    Application.Goto Reference:="R1C1"
'copy your path from A3 to AA3, so A to Z can be deleted
    Application.Goto Reference:="R1C1"
    Application.Goto Reference:="R3C1"
    Selection.Copy
    Application.Goto Reference:="R3C27"
    ActiveSheet.Paste
    Application.Goto Reference:="R1C1"
'''delete all A to Z first
    Application.Goto Reference:="R1C1"
    ActiveCell.Columns("A:Z").EntireColumn.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Application.Goto Reference:="R1C1"

'''run macro to get files in folder
    Sheets("ListFiles").Select
    Application.Goto Reference:="R1C1"
    Application.Run "Now_GetFileProperties"
    
'''go to the sheet ListFiles
    Application.Goto Reference:="R1C1"
    Sheets("ListFiles").Select
    Application.Goto Reference:="R1C1"
End Sub



Sub Macro20()
'find last row in C, put in A2 for use later
    Sheets("ListFiles").Select
    Application.Goto Reference:="R1C1"
    Application.Goto Reference:="R999999C3"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.Clear
    Selection.FormulaR1C1 = "=ROW()"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Cut
    Application.Goto Reference:="R1C1"
    ActiveSheet.Paste
'minus 7 in A2, as the data starts on row7
    Application.Goto Reference:="R2C1"
    Selection.FormulaR1C1 = "=R[-1]C-7"
End Sub

Sub Macro21()
'''add path to column B, use A1 as the range to paste
    Sheets("ListFiles").Select
    Application.Goto Reference:="R1C1"
    Application.Goto Reference:="R7C2"
    Selection.FormulaR1C1 = "=R3C1&RC[1]"
    Selection.Copy
    Selection.Copy
'''    ActiveCell.Range("A1:A641989").Select
    ActiveCell.Range("A1:A" & Range("a2")).Select
    ActiveSheet.Paste
    Calculate
    Selection.Copy
''paste as values
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

Sub Macro22()
'copy to A, so it is a backup
    Sheets("ListFiles").Select
    Application.Goto Reference:="R1C1"
    Application.Goto Reference:="R1C2"
    Selection.End(xlDown).Select
    Selection.Copy
    Application.Goto Reference:="R7C2"
    Application.CutCopyMode = False
    Selection.Copy
'''    ActiveCell.Range("A1:A641989").Select
    ActiveCell.Range("A1:A" & Range("a2")).Select
    Application.CutCopyMode = False
    Selection.Copy
    Application.Goto Reference:="R7C1"
    ActiveSheet.Paste
End Sub

Sub Macro23()
'best fit columns
    Sheets("ListFiles").Select
    Application.Goto Reference:="R1C1"
    Application.Goto Reference:="R1C1"
    ActiveCell.Columns("A:Z").EntireColumn.Select
    Selection.Columns.AutoFit
    Application.Goto Reference:="R1C1"
End Sub


Sub Macro29()
'open file based on cell B1
    Sheets("ListFiles").Select
    Application.Goto Reference:="R1C1"
    Application.DisplayAlerts = False
    Application.Goto Reference:="R1C2"
    Selection.End(xlDown).Select
    Selection.Cut
    Application.Goto Reference:="R1C2"
    ActiveSheet.Paste
'''    Workbooks.Open Filename:="C:\temp2\6489\TankMan.csv"
''open as cell B1
    Workbooks.Open Filename:=Range("b1")
''save as Temp, so it is a static name, and easier to work with a static name. should not matter, as you're copying the data and not manipulating the data in here
    ActiveWorkbook.SaveAs Filename:="C:\temp2\6489\temp_delete_me.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub


Sub Macro30()
'put number of row and columns in A1 and B1.  Messing up your header in row 1, but should not matter, since your data all have the same header.
    Windows("temp_delete_me.xlsx").Activate
    ActiveCell.SpecialCells(xlLastCell).Select
    ActiveCell.Offset(1, 1).Range("A1").Select
    Selection.Clear
    Selection.FormulaR1C1 = "=COLUMN()"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.FormulaR1C1 = "=ROW()"
    Selection.Copy
    ActiveCell.Offset(0, -1).Range("A1").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Range("A1:B1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Application.CutCopyMode = False
    Calculate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Cut
    Application.Goto Reference:="R1C2"
    ActiveSheet.Paste
    Selection.Copy
    Application.Goto Reference:="R1C3"
    Application.CutCopyMode = False
    Selection.Copy
    Application.Goto Reference:="R1C1"
    ActiveSheet.Paste
End Sub

Sub Macro31()
'''copy data from
    Application.DisplayAlerts = False
    Windows("temp_delete_me.xlsx").Activate
    Application.Goto Reference:="R1C1"
    Application.Goto Reference:="R2C1"
''    ActiveCell.Rows("1:64").EntireRow.Select
'''based A1 minus1, for the number of rows.  minus1, since you are not copying row1
    ActiveCell.Rows("1:" & Range("a1") - 1).EntireRow.Select
    Application.CutCopyMode = False
    Selection.Copy
    
    
'''really important here.  assumes column A is ALWAYS filled with data.  If a cell in column A does not have data, this will overwrite the data in B to XFC
    Windows("Master.xlsm").Activate
    Sheets("MasterSheet").Select
    Application.Goto Reference:="R999999C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.Goto Reference:="R1C1"

'close temp sheet
    Windows("temp_delete_me.xlsx").Activate
    ActiveWindow.Close
End Sub
 
Upvote 0
Just putting this out there. While a Macro could do this, Power Query is going to be a lot easier to do and a lot more efficient.+

Data->Get Data ->From File-> From Folder -> Navigate to Folder -> Combine Drop Down - >Combine & Transform Data -> OK -> Transform Sample File (Left side bar) -> Do Transformations -> Close and Load
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Locked
  • Question Question
Severe Amateur needs code to pull data from multiple sheets into one master
Replies
1
Views
121
Peter_SSs
Peter_SSs
J
  • Question Question
Merge several csv files into one workbook
Replies
6
Views
163
alansidman
alansidman
A
  • Question Question
Cancel merged columns and arrange structure across files in the folders
2 3
Replies
20
Views
362
Joe4
Joe4
A
  • Solved
Pulling Specific Data from multiple separate excel files into one Master File
2 3
Replies
21
Views
503
mumps
mumps
D
  • Solved
VBA macro/button to copy data from multiple workbooks into master workbook
Replies
5
Views
345
John_w
J

Forum statistics

Threads
1,226,735
Messages
6,192,733
Members
453,752
Latest member
Austin2222

Share this page

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