Multiple files into one BUT different tabs

[ChicagoGuy]

I would like to pull multiple one tab reports into a single file BUT I want each of the files on its own tab


I have report that I pull from a another system into an excel sheet. Each day I save this file with that days date. The file has the same headers but the data changes.

I have several months worth of this report. Again every day is the same headers exactly but different data below them. What I need to do is analyze at least one of these columns to show a historical progresssion over time. What i think would be the way to do this would be to bring all the files into one but have each days file onto a different tab. then i could run a pivot or some other analysis. Additionally it would be nice to have the tab named based on the file but thats less important

I hope i am making sense

To give you en example of the file data. You can see on day1 i have two peices of fruit and certain status for each but on another day i have 3 peices and the status is different. Instead of two files dated NOV1 and NOV2. I want one File with Tab1=NOV1 Data and TAB2= NOV2 Data. I can find many examples of how to pull all this data into a single new sheet but nothing that shows how to bring multiple files in one file with multiple tabs

NOV 1, 32017
[TABLE="width: 500"]
<tbody>[TR]
[TD]FRUIT
[/TD]
[TD]FRESH
[/TD]
[TD]SPOILED
[/TD]
[TD]SOLD
[/TD]
[/TR]
[TR]
[TD]apple
[/TD]
[TD]5
[/TD]
[TD]3
[/TD]
[TD]7
[/TD]
[/TR]
[TR]
[TD]pear
[/TD]
[TD]2
[/TD]
[TD]4
[/TD]
[TD]6
[/TD]
[/TR]
</tbody>[/TABLE]

NOV 2, 32017
[TABLE="width: 500"]
<tbody>[TR]
[TD]FRUIT
[/TD]
[TD]FRESH
[/TD]
[TD]SPOILED
[/TD]
[TD]SOLD
[/TD]
[/TR]
[TR]
[TD]apple
[/TD]
[TD]2
[/TD]
[TD]7
[/TD]
[TD]3
[/TD]
[/TR]
[TR]
[TD]pear
[/TD]
[TD]6
[/TD]
[TD]7
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]orange
[/TD]
[TD]2
[/TD]
[TD]8
[/TD]
[TD]5
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[Fluff]

How about

Sub ConsolidateWbk()

    Dim Pth As String
    Dim Wbk As Workbook
    Dim Fname As String
    
Application.ScreenUpdating = False

    Pth = "C:\Users\DaveC\Desktop\test\"
    Set Wbk = Workbooks.Add(1)
    Fname = Dir(Pth & "*xls*")
    Do While Len(Fname) > 0
        Workbooks.Open (Pth & Fname)
        With Workbooks(Fname)
            .Sheets(1).Copy after:=Wbk.Sheets(1)
            Wbk.Sheets(2).Name = Left(Fname, InStr(Fname, ".") - 1)
            .Close , False
        End With
        Fname = Dir
    Loop
Application.DisplayAlerts = False
    Wbk.Sheets(1).Delete
Application.DisplayAlerts = True

End Sub