Pull data in from multiple excel files into one file (avoid copy and paste each one)

[davidl7]

I have historic data going back a few months.

Each individual file is saved with that days date and are all in the same format.

My aim is to have this data together in one spreadsheet so i can chart/analyses changes.

Obviously i could copy and paste each file into a new spreadsheet - but this would take a while and require a lot of maintenance.

Any thoughts would be great - thanks.

 

[tonyyy]

davidl7,

Here's a thought...

Sub GenericMaster_1018932()
Application.ScreenUpdating = False
Dim wb As Workbook, wb2 As Workbook
Dim FolderName As String, fileName As String
Dim NextRow As Long
Dim ws As Worksheet

''''Select folder that contains files
With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  If .Show = 0 Then Exit Sub
  FolderName = .SelectedItems(1) & "\"
End With

Set wb = Workbooks.Add
fileName = Dir(FolderName & "*.xls?")

''''Loop through files
Do While fileName <> ""
    If fileName <> wb.Name Then
        Set wb2 = Workbooks.Open(FolderName & fileName)
            ''''Loop through sheets
            For Each ws In wb2.Worksheets
                NextRow = wb.Sheets(1).Cells(wb.Sheets(1).Rows.Count, "A").End(xlUp).Row + 1
                ws.UsedRange.Copy Destination:=wb.Sheets(1).Cells(NextRow, 1)
            Next ws
        wb2.Close savechanges:=False
    End If
    fileName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "The dishes are done, dude!"
End Sub

Cheers,

tonyyy

 

[davidl7]

Hi Tony - thanks for the reply.

I select the folder but then nothing happens - it doesn't pull in any of the files.. not sure what the problem is?

I have created this macro - ideally would like it all on one tab:

Sub GetSheets()
Path = "C:\My Documents\savedfiles"
Filename = Dir(Path & "*.csv")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

 

[davidl7]

ignore my previous comment Tony - ive got it to work.

That is really useful - thanks you.

If i want the sheets to appear side by side rather than below , is there a way to write this in ? Thank you again - saved me a lot of time!

 

[tonyyy]

ignore my previous comment Tony - ive got it to work.

That is really useful - thanks you.

If i want the sheets to appear side by side rather than below , is there a way to write this in ? Thank you again - saved me a lot of time!

Glad you got it to work. You're welcome.

When you say you want "the sheets to appear side by side," I assume you mean the data from the sheets...

Sub GenericMasterHorizontal_1018932()
Application.ScreenUpdating = False
Dim wb As Workbook, wb2 As Workbook
Dim FolderName As String, fileName As String
Dim NextRow As Long[COLOR=#ff0000], NextColumn As Long[/COLOR]
Dim ws As Worksheet

''''Select folder that contains files
With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  If .Show = 0 Then Exit Sub
  FolderName = .SelectedItems(1) & "\"
End With

Set wb = Workbooks.Add
fileName = Dir(FolderName & "*.xls?")

''''Loop through files
Do While fileName <> ""
    If fileName <> wb.Name Then
        Set wb2 = Workbooks.Open(FolderName & fileName)
            ''''Loop through sheets
            For Each ws In wb2.Worksheets
[COLOR=#ff0000]                NextColumn = wb.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column + 1
                ws.UsedRange.Copy Destination:=wb.Sheets(1).Cells(1, NextColumn)[/COLOR]
            Next ws
        wb2.Close savechanges:=False
    End If
    fileName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "The dishes are done, dude!"
End Sub

 

[davidl7]

argh - i was very nearly there.

It looks like the macro pulls the saved files in in a random order into the spreadsheet but i want them to follow the same order as they are saved (by date). Do you know why it pulls them in this order & is there a way to correct this ?!

Hope that makes sense & thanks again for your help.

 

[tonyyy]

@davidl7 - A request please... In future posts, please include as much detail as possible in your description. Granted, I knew from your initial post (which is very general and lacks any detail) that modifications would be necessary to my initial code. But the comment in your post #6 - "...the macro pulls the saved files in in a random order into the spreadsheet but i want them to follow the same order as they are saved (by date)..." - required a significant rewrite. So, a bit of detail will save us both a bit of time and energy. (Please don't read this as a criticism; it's just a request.)

That said, the following code contains three top level loops: The first to populate an array with the file names and modified dates; the second to sort the array; and the third to copy/paste the data...

Sub GenericMasterByDateModified_1018932()
Application.ScreenUpdating = False
Dim wb As Workbook, wb2 As Workbook
Dim FolderName As String
Dim NextRow As Long, NextColumn As Long
Dim ws As Worksheet

Dim fso As Object, objFiles As Object, obj As Object
Dim kount As Long, i As Long, j As Long
Dim arr As Variant
Dim x As Long, y As Long
Dim Txt1 As Date, Txt2 As Date, Txt3 As String, Txt4 As String

''''Select folder that contains files
With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  If .Show = 0 Then Exit Sub
  FolderName = .SelectedItems(1) & "\"
End With

Set fso = CreateObject("Scripting.FileSystemObject")
Set objFiles = fso.GetFolder(FolderName).Files
kount = objFiles.Count

''''Loop through files and populate array with file name and date last modified
ReDim arr(1 To kount, 1 To 2)
i = 1
For Each obj In objFiles
    arr(i, 1) = obj.Name
    arr(i, 2) = obj.datelastmodified
    i = i + 1
Next obj

''''Sort array by date last modified (Descending)
For x = LBound(arr) To UBound(arr)
    For y = x To UBound(arr)
        If arr(y, 2) > arr(x, 2) Then 'Change ">" to "<" for Ascending sort
            Txt1 = arr(x, 2)
            Txt2 = arr(y, 2)
            Txt3 = arr(x, 1)
            Txt4 = arr(y, 1)
            
            arr(x, 2) = Txt2
            arr(y, 2) = Txt1
            arr(x, 1) = Txt4
            arr(y, 1) = Txt3
        End If
    Next y
Next x

Set wb = Workbooks.Add
''''Loop through files in order of array
For x = LBound(arr) To UBound(arr)
    Set wb2 = Workbooks.Open(FolderName & arr(x, 1))
        ''''Loop through sheets
        For Each ws In wb2.Worksheets
            NextColumn = wb.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column + 1
            ws.UsedRange.Copy Destination:=wb.Sheets(1).Cells(1, NextColumn)
        Next ws
    wb2.Close savechanges:=False
Next x

Application.ScreenUpdating = True
MsgBox "The dishes are done, dude!"
End Sub

Hope that makes sense & thanks again for your help.

You're very welcome...