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

John_Help_Me

New Member
Joined
May 15, 2006
Messages
17
All:

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.

THANKS A BUNCH.
John
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

texasalynn

Well-known Member
Joined
May 19, 2002
Messages
8,458
do a search on this forum for "consolidating" and you should get some good suggestions
 

John_Help_Me

New Member
Joined
May 15, 2006
Messages
17
Thanks,

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

John
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,300
Office Version
  1. 365
Platform
  1. Windows
John

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?
 

btadams

Well-known Member
Joined
Jan 6, 2003
Messages
1,941
Here's what I use:

Code:
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
        Workbooks.Add
        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
            Workbooks(strSourceDataFile).Activate
            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
            
          Wend
        
quit:
        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
exitsub:
On Local Error GoTo 0
Application.ScreenUpdating = True

End Sub
 

Forum statistics

Threads
1,136,616
Messages
5,676,835
Members
419,653
Latest member
analyticalchemist94

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
Top