Copy/Paste files from folder into new spreadsheet with tabs

[csmithee]

I have a folder full of workbooks with one spreadsheet that I would like to be copied and pasted into a new destination spreadsheet. So, there are 16 files in this source folder, and they all have one tab with data called "Report". I want each of those 16 tabs to be copied over to the destination worksheet as new tabs. However, since all the tabs are named "Report", I would like the macro to rename the tab based on the filename of the source workbook, then copy/paste into a the destination workbook. I would end up with 16 tabs, all renamed according to the source workbook they came from. Is this possible???

Thank You!

 

[csmithee]

Any help would be greatly appreciated.

 

[jbeaucaire]

This is a macro I use for this very task, I've edited it for your needs, adjust the path:

Option Explicit

Sub Consolidate()
'JBeaucaire (7/6/2009)     (2007 compatible)
'Open all Excel files in a specific folder and import data as separate sheets

Dim strFileName As String, strPath As String
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

'Setup
    Set wbkNew = ThisWorkbook
    wbkNew.Activate

'Remove existing sheets (optional, remove this section if appending is desired)
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    For Each ws In Worksheets
        If ws.Name <> "Temp" Then ws.Delete
    Next ws

'Folder that holds the workbooks to import
    strPath = "C:\My Documents\Reports\"
    If Left(strPath, 1) <> "\" Then strPath = strPath & "\"

'List of files to import
    strFileName = Dir(strPath & "*.xl*")

'Import Report sheet with new name from all workbooks
    Do While Len(strFileName) > 0
        Set wbkOld = Workbooks.Open(strPath & strFileName)
        'Rename sheet to name of workbook opened
        ActiveSheet.Name = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
        Activesheet.Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
        strFileName = Dir
        wbkOld.Close False
    Loop
    
'Delete the temp sheet leaving only reports
wbkNew.Sheets("Temp").Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[csmithee]

Thank you so much....works perfect for me!