Loop to copy and rename specific worksheet within folder

[Steven101]

Hi, I have a folder that holds a Master Workbook. I'm looking to get a macro that will look at every file (excluding the master workbook) where the master sheet is stored and copy the "Data" sheet from each workbook into the Master sheet.

I also need to rename each sheet that is copied to the filename it has been copied from. Each source workbook will be a persons name, so I should end up with worksheet tabs with peoples names in the master workbook.

Hope this makes sense?

I've looked at various posts but nothing quite matched what I'm looking for.

Any help would be appreciated.

Thanks, S

 

[cpatel13]

Hi, I have a folder that holds a Master Workbook. I'm looking to get a macro that will look at every file (excluding the master workbook) where the master sheet is stored and copy the "Data" sheet from each workbook into the Master sheet.

I also need to rename each sheet that is copied to the filename it has been copied from. Each source workbook will be a persons name, so I should end up with worksheet tabs with peoples names in the master workbook.

Hope this makes sense?

I've looked at various posts but nothing quite matched what I'm looking for.

Any help would be appreciated.

Thanks, S

Hie Steven 101,

Here is the below code, few things you need to make sure in order to make this work properly.
1) Make sure your master workbook is not in the same folder where your other files are located from which the data needs to be extracted. IMP
2) enter the below code in your personal macro workbook. and then run it.

Sub LoopThroughFiles()
    
    FolderName = "[B]Folderpath of your files from which the data needs to be extracted[/B]"
    If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
    Fname = Dir(FolderName & "*.xlsx")


    'loop through the files
    Do While Len(Fname)


        With Workbooks.Open(FolderName & Fname)


        
        
        Dim wb1 As ThisWorkbook
        Dim wb2 As Workbook
        Dim wrkshtname As String
        Application.ScreenUpdating = True
        Set wb1 = ThisWorkbook
        wrkshtname = ActiveWorkbook.Name
        ActiveWorkbook.Sheets("Data").Activate
        ActiveSheet.UsedRange.Copy
        Set wb2 = Workbooks.Open("[B]Full Path of your Master Workbook[/B]")
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Data"
        ActiveSheet.Paste
        Application.ScreenUpdating = False
        activateworkbook = ("wb1")
        activateworkbook = ("wb2")
        ActiveWorkbook.ActiveSheet.Name = wrkshtname
        ActiveWorkbook.Close savechanges:=True
        ActiveWorkbook.Close savechanges:=True
         
         
        End With


        ' go to the next file in the folder
        Fname = Dir


    Loop
    
End Sub

Regards,
Cpatel13

A Like and a feedback would be appreciated.

 

[Steven101]

Hie Steven 101,

Here is the below code, few things you need to make sure in order to make this work properly.
1) Make sure your master workbook is not in the same folder where your other files are located from which the data needs to be extracted. IMP
2) enter the below code in your personal macro workbook. and then run it.

Sub LoopThroughFiles()
    
    FolderName = "[B]Folderpath of your files from which the data needs to be extracted[/B]"
    If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
    Fname = Dir(FolderName & "*.xlsx")




    'loop through the files
    Do While Len(Fname)


        With Workbooks.Open(FolderName & Fname)


        
        
        Dim wb1 As ThisWorkbook
        Dim wb2 As Workbook
        Dim wrkshtname As String
        Application.ScreenUpdating = True
        Set wb1 = ThisWorkbook
        wrkshtname = ActiveWorkbook.Name
        ActiveWorkbook.Sheets("Data").Activate
        ActiveSheet.UsedRange.Copy
        Set wb2 = Workbooks.Open("[B]Full Path of your Master Workbook[/B]")
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Data"
        ActiveSheet.Paste
        Application.ScreenUpdating = False
        activateworkbook = ("wb1")
        activateworkbook = ("wb2")
        ActiveWorkbook.ActiveSheet.Name = wrkshtname
        ActiveWorkbook.Close savechanges:=True
        ActiveWorkbook.Close savechanges:=True
         
         
        End With


        ' go to the next file in the folder
        Fname = Dir


    Loop
    
End Sub

Regards,
Cpatel13

A Like and a feedback would be appreciated.

Thanks for the quick response.

Getting an error message as I'm running the macro from my master file (which I need to do) The error is when it's trying to reopen the master file.

Also is there any way to remove the file extension when renaming the "Data" sheet?

Cheers S

 

[cpatel13]

Thanks for the quick response.

Getting an error message as I'm running the macro from my master file (which I need to do) The error is when it's trying to reopen the master file.

Also is there any way to remove the file extension when renaming the "Data" sheet?

Cheers S

Hie,
you need to make sure that you need to put the macro in the personal macros. once it is done, then just open excel and close any workbook, and then just run the macro, should work properly.