Merge multiple workbooks into one new worksheet

[bjaytiamsic26]

Hi!

I have tried merging multiple workbooks in the same folder in to one worksheet.
here is the link where I got the VBA Code.

https://sites.google.com/a/madrocket...s-to-one-sh...

I tried editing the code and I came up with

Option Explicit 
Sub Consolidate() 
     'Author:     Jerry Beaucaire'
     'Date:       9/15/2009     (2007 compatible)  (updated 4/29/2011)
     'Summary:    Merge files in a specific folder into one master sheet (stacked)
     '            Moves imported files into another folder
    Dim fName As String, fPath As String, fPathDone As String 
    Dim LR As Long, NR As Long 
    Dim wbData As Workbook, wsMaster As Worksheet 
     'Setup
    Application.ScreenUpdating = False 'speed up macro execution
    Application.EnableEvents = False 'turn off other macros for now
    Application.DisplayAlerts = False 'turn off system messages for now
     
    Set wsMaster = ThisWorkbook.Sheets("Sheet1") 'sheet report is built into
    With wsMaster 
        If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then 
            .UsedRange.Offset(1).EntireRow.Clear 
            NR = 2 
        Else 
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'appends data to existing data
        End If 
         'Path and filename (edit this section to suit)
        MsgBox "Please select a folder with files to consolidate" 
        Do 
            With Application.FileDialog(msoFileDialogFolderPicker) 
                .InitialFileName = "C:" 
                .AllowMultiSelect = False 
                .Show 
                If .SelectedItems.Count > 0 Then 
                    fPath = .SelectedItems(1) & "\" 
                    Exit Do 
                Else 
                    If MsgBox("No folder chosen, do you wish to abort?", _ 
                    vbYesNo) = vbYes Then Exit Sub 
                End If 
            End With 
        Loop 
         
         
         
         'remember final \ in this string
        fPathDone = fPath & "Imported\" 'remember final \ in this string
        On Error Resume Next 
        MkDir fPathDone 'creates the completed folder if missing
        On Error Goto 0 
        fName = Dir(fPath & "*.xls*") 'listing of desired files, edit filter as desired
         'Import a sheet from found files
        Do While Len(fName) > 0 
            If fName <> ThisWorkbook.Name Then 'don't reopen this file accidentally
                Set wbData = Workbooks.Open(fPath & fName) 'Open file
                 'This is the section to customize, replace with your own action code as needed
                LR = Range("A" & Rows.Count).End(xlUp).Row 'Find last row
                Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR) 
                wbData.Close False 'close file
                NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Next row
                Name fPath & fName As fPathDone & fName 'move file to IMPORTED folder
            End If 
            fName = Dir 'ready next filename
        Loop 
    End With 
ErrorExit: 'Cleanup
    ActiveSheet.Columns.AutoFit 
    Application.DisplayAlerts = True 'turn system alerts back on
    Application.EnableEvents = True 'turn other macros back on
    Application.ScreenUpdating = True 'refreshes the screen
End Sub

However, when I tried to run it and chose the appropriate folder, only the CELL B2 appeared in my worksheet.

I attached the sample workbooks I am using. Please change week1 in the URL to "week2" and "week3" to get the 2 files.

Any help would be much appreciated.

Thanks and Best Regards,
Bob

 

[SkipVought]

Hi,

Sub consolidate()
   Dim oFSO as object, oFile as object, lRow as long, sPath 

   With ThisWorkbook.Sheets("Sheet1")
       sPath = application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
       If sPath <> False Then
          sPath = left(sPath, instrrev(sPath, "\")-1)
          Set oFSO = CreateObject("Scripting.FileSystemObject")
          For Each oFile in oFSO.GetFolder(sPath)
             With workbooks.Open(oFile.Name)
                 With Sheets(1)
                    Intersect(.UsedRange, .Range(.rows(2), .rows(2).end(xlDown))).copy
                 End with
                 .Close
             End with
             lRow = .UsedRange.rows.count + .row
             .Cells(lRow, "A").PasteSpecial xlPasteValued
          Next
       End If
   End with
End sub

Hope this works as I did this on my iPad without Excel. The other features in your posted code like clear or not, you can add if desired.

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[bjaytiamsic26]

I came up with the error "Object doesn't support this property or method" on the line: For Each oFile In oFSO.GetFolder(sPath)

 

[SkipVought]

Sorry

    For Each oFile in oFSO.GetFolder(sPath).Files

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[SkipVought]

sorry, that my coding memory is so deficient.

This code I tested...

Sub consolidate()
   Dim oFSO As Object, oFile As Object, lRow As Long, sPath, wb As Workbook

    Application.DisplayAlerts = False

   With ThisWorkbook.Sheets("Sheet1")
       sPath = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
       If sPath <> False Then
          sPath = Left(sPath, InStrRev(sPath, "\") - 1)
          Set oFSO = CreateObject("Scripting.FileSystemObject")
          For Each oFile In oFSO.GetFolder(sPath).Files
'[b].Path is the proper property[/b]
             Set wb = Workbooks.Open(oFile.Path)
             With wb.Sheets(1)
                Intersect(.UsedRange, .Range(.Rows(2), .Rows(2).End(xlDown))).Copy
             End With
'[b].UsedRange needed for each row value[/b]
             lRow = .UsedRange.Rows.Count + .UsedRange.Row
'[b]pastes before closing the source workbook[/b]
             .Cells(lRow, "A").PasteSpecial xlPasteValues
             wb.Close
          Next
       End If
   End With
    Application.DisplayAlerts = True
End Sub

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[combo]

In addition to Skip's code, depending on location of files , you may additionally need to test:
- if oFile.Path is an excel file (other than excel files in directory?):
Right(sPath, InStrRev(sPath, ".")) Like "xls*"
- if oFile.Path is not a master workbook:
oFile.Path <> ThisWorkbook.FullName


combo

 

[bjaytiamsic26]

Thank you!
I will try my best to understand the code. I just got into VBA.

 

[bjaytiamsic26]

Nothing happened when I execute the code.
I tried searching for functions of lines/properties that i do not understand.

I opened all the files in the folder I used but nothing changed.