I need a Macro - job is on the line!!!


New Member
May 15, 2006

Under the eight ball here. I have been given 100 files. Each file has a different number of tabs ranging from 2 - 10. The data within each tab is all aligned perfectly - meaning cell A1 refers the same type of data. The data resides in the range A1:G20. What I need is a way to open all the files (which are named differently, but are in the same folder) and extract that data into one worksheet. As long as the data is in one worksheet I am good to go. I will be monitoring this post. If you need clarifaction, let me know. Any help is greatly appreciated.


Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
do a search on this forum for "consolidating" and you should get some good suggestions
Upvote 0

Unfortunately, I amreally under the gun. Does anyone have some fresh code or a link to a specific message?

Upvote 0

I would really suggest you follow texasalynn's advice and try a board search.

You'll find hundreds, perhaps thousands, of posts dealing with this topic.

It's hard to just pull code out of a hat.

For example, we don't know the name of the folder.

We don't know exactly how the data is structured. eg are there header rows?

Do you need to include the workbook/worksheet name somewhere in the consolidated data?
Upvote 0
Here's what I use:

Sub CombineMultipleFiles2()
Dim varFilenames As Variant
Dim strActiveBook As String
Dim strSourceDataFile As String
Dim strTest As String
Dim wSht As Worksheet
Dim allwShts As Sheets
    intResponse = MsgBox("This macro will combine all data from all worksheets from all selected files" & vbCrLf & "to a single worksheet in a new workbook. Continue?", vbOKCancel, "Combine Worksheets to One Sheet")
    If intResponse = vbOK Then
        strActiveBook = ActiveWorkbook.Name
       ' Create array of filenames; the True is for multi-select
       On Error GoTo exitsub
        varFilenames = Application.GetOpenFilename(, , , , True)
          counter = 1
          ' ubound determines how many items in the array
          On Error GoTo quit
    '      Workbooks.Add
          Application.ScreenUpdating = False
          While counter <= UBound(varFilenames)
             'Opens the selected files
            Workbooks.Open varFilenames(counter)
            strSourceDataFile = ActiveWorkbook.Name
            Set allwShts = Worksheets
            For Each wSht In allwShts
                If wSht.Visible = True Then
                    If wSht.Type = -4167 Then
                        ' Select Entire UsedRange from Source File
                        wSht.UsedRange.Copy Destination:=Workbooks(strActiveBook).Worksheets(1).Range("A65536").End(xlUp).Offset(1, 0)
'                        ActiveSheet.UsedRange.Select
'                        Selection.Copy
'                        ' Find end of usedrange in destination file
'                        Workbooks(strActiveBook).Activate
'                        Range("A1").Select
'                        ActiveSheet.UsedRange.Select
'                        lRows = Selection.Rows.count
'                        ActiveCell.Offset(lRows, 0).Select
'                        ' Copy & Paste All including Formatting
'                        Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:= _
'                        False, Transpose:=False
'                            Selection.Copy
'                        Range("A1").Select
        '                 Copy & Paste Values
        '                Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        '                False, Transpose:=False
                    End If
                End If
            Next wSht
            Application.DisplayAlerts = False
            ActiveWorkbook.Close savechanges:=False
            Application.DisplayAlerts = True
            ' displays file name in a message box
            MsgBox varFilenames(counter) & " Has Been Processed", vbOKOnly + vbInformation, "File Processed"
             'increment counter
             counter = counter + 1
        If Err <> 0 Then
        MsgBox "An Error Occurred Trying to open the File. Please close any open Excel files and try again", vbOKOnly + vbExclamation, "File Open Error"
        On Local Error GoTo 0
        End If
    End If
On Local Error GoTo 0
Application.ScreenUpdating = True

End Sub
Upvote 0

Forum statistics

Latest member

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