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

[John_Help_Me]

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

 

[texasalynn]

do a search on this forum for "consolidating" and you should get some good suggestions

 

[John_Help_Me]

Thanks,

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

John

 

[Norie]

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]

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
        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

 

[John_Help_Me]

That worked beautifully. Thanks.