Copy/Paste files from folder into new spreadsheet with tabs

csmithee

New Member
Joined
Jun 10, 2009
Messages
18
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!
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
This is a macro I use for this very task, I've edited it for your needs, adjust the path:

Rich (BB code):
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
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,947
Members
448,534
Latest member
benefuexx

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