macro/code to insert specific sheet into all workbooks in folder

[prkhan56]

Hello All,
I am using Excel 2013 and I have a Workbook where I have a Sheet name "Notes"
I want to copy this sheet as the last sheet in all the workbooks in a folder in the following path.
"C:\Username\Macro\Test\"

I got the code on this group from the year 2008 but it does not copy the Notes sheet in any of the workbook in the given path.

This is the link to the thread.

macro/code to insert specific sheet into all workbooks in folder

I have a specific Worksheet set up as a formatted "template" and want to add it to every file/workbook in a specific folder. Each of these files only contains Sheet1 and the 'template' is named "add". Is there an easy way to do this?

www.mrexcel.com

I changed xls to xlsx, the sheet name from "add" to "Notes" and the path accordingly but it still does not copy the "Notes" in all the workbook.

Any help in modifying the existing code or a new code would be greatly appreciated.

Note: Both the codes in the above thread does not work

TIA

 

[Alex Blakenburg]

Did you actually try the solution provided by xlhth in that thread you provided the link for ?

Here it is modified per your requirements.

Sub test_Modified()
    Dim SrcBook As Workbook
    Dim fso As Object         'File System Object
    Dim f As Object           'Folder
    Dim ff As Object          'Folder Files
    Dim f1 As Object          'File to add template sheet
    Dim fst As Object         'template worksheet
 
    Application.ScreenUpdating = False
    Set fst = ThisWorkbook.Worksheets("Notes")
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' XXX Put in your folder - make sure there is "\" at the end
    Set f = fso.Getfolder("C:\Username\Macro\Test\")
    Set ff = f.Files
 
    For Each f1 In ff
        Set SrcBook = Workbooks.Open(f1)
        'object reference
        ' XXX Changed from Worksheets(1) to put it at the end per requirements
        fst.Copy After:=SrcBook.Worksheets(SrcBook.Worksheets.Count)
        'copy template sheet
        ' XXX Changed from Worksheets(1) to put it at the end per requirements
        SrcBook.Worksheets(SrcBook.Worksheets.Count).Activate
        'activate first worksheet
        SrcBook.Close True
        'close file saving without prompt
    Next
    Application.ScreenUpdating = True
    Set SrcBook = Nothing      'release system resources
    Set fst = Nothing
    Set fso = Nothing
    Set f = Nothing
    Set ff = Nothing
 
End Sub

 

[LazyBug]

Hello!

If you want to run macro from the file with worksheet you need to copy, try this. In the code current file name is copy_ws_to_wbs_in_folder.xls, sheet you want to copy is NEW_ws, and full path to folder with uts name is D:\TEST\copy_ws_to_wbs_in_folder\; amend to yours.

Sub copyWS2WBs()
Dim arrF(), i&, p$, f$, ws As Worksheet
    p = "D:\TEST\copy_ws_to_wbs_in_folder\"
    Set ws = Workbooks("copy_ws_to_wbs_in_folder.xls").Sheets("NEW_ws")    ' Set ws = ThisWorkbook.Sheets("NEW_ws")
    Application.ScreenUpdating = False
   
    f = Dir(p & "*.xls")
    Do While f <> ""
        ReDim Preserve arrF(i)
        arrF(i) = p & f
        i = i + 1
        Workbooks.Open p & f
        ws.Copy after:=ActiveWorkbook.Sheets(ActiveWorkbook.Worksheets.Count)
        ActiveWorkbook.Close 1
        f = Dir
    Loop

MsgBox "done!"
      
End Sub

 

[prkhan56]

Did you actually try the solution provided by xlhth in that thread you provided the link for ?

Here it is modified per your requirements.

Sub test_Modified()
    Dim SrcBook As Workbook
    Dim fso As Object         'File System Object
    Dim f As Object           'Folder
    Dim ff As Object          'Folder Files
    Dim f1 As Object          'File to add template sheet
    Dim fst As Object         'template worksheet
 
    Application.ScreenUpdating = False
    Set fst = ThisWorkbook.Worksheets("Notes")
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' XXX Put in your folder - make sure there is "\" at the end
    Set f = fso.Getfolder("C:\Username\Macro\Test\")
    Set ff = f.Files
 
    For Each f1 In ff
        Set SrcBook = Workbooks.Open(f1)
        'object reference
        ' XXX Changed from Worksheets(1) to put it at the end per requirements
        fst.Copy After:=SrcBook.Worksheets(SrcBook.Worksheets.Count)
        'copy template sheet
        ' XXX Changed from Worksheets(1) to put it at the end per requirements
        SrcBook.Worksheets(SrcBook.Worksheets.Count).Activate
        'activate first worksheet
        SrcBook.Close True
        'close file saving without prompt
    Next
    Application.ScreenUpdating = True
    Set SrcBook = Nothing      'release system resources
    Set fst = Nothing
    Set fso = Nothing
    Set f = Nothing
    Set ff = Nothing
 
End Sub

Dear Alex and LazyBug,
Thanks to both of you for your time and help.
Works great but a small request to both of you.
When I run the same code on my daughter's Laptop which has O365 it does not run.
Does the code needs to be modified for O365. If both of you can tweak it to run it on O365 then if would be a great help for us.
Thanks once again for your time and help.

 

[Alex Blakenburg]

I am running MS365 and both lots of code work for me.
Is her laptop a Mac by any chance ?

 

[prkhan56]

I am running MS365 and both lots of code work for me.
Is her laptop a Mac by any chance ?

Dear Alex,
No it is not.
Thanks for your prompt response.

 

[Alex Blakenburg]

So what does it do on your daughters machine ?
If there is an error show us the error and which line is highlighted when you hit debug.
If there is no error did you change the file path so that it is the right path for her machine ?

If none of that works do you know how to step through the code using <F8>, to see if it is processing all the steps.

An invalid file path is the most likely though.

 

[prkhan56]

So what does it do on your daughters machine ?
If there is an error show us the error and which line is highlighted when you hit debug.
If there is no error did you change the file path so that it is the right path for her machine ?

If none of that works do you know how to step through the code using <F8>, to see if it is processing all the steps.

An invalid file path is the most likely though.

Dear Alex,
I found the error.
Actually pardon me for putting the question wrong initially.
Under the "Test" Folder there are many subfolders which have the required workbook where the "Notes" sheet should be copied.
Your macro works on all the files if they are under the "Test" directory (which is what it is supposed to do) but not under the sub folders under "Test"
Hope you understand my requirement now.
So please can you modify to run it under the sub-folder under "Test" too.
Thanks once again for all your time and help.

 

[LazyBug]

Maybe... (Subroutine "test_Modified_w_subfolders" will create copy of sheet Notes in all files .xls in folder Test, include subfolders)

Dim fso As Object, f As Object, f1 As Object, SrcBook As Workbook, fst As Object

Sub test_Modified_w_subfolders()
Dim s As String

s = "C:\Username\Macro\Test\"
s = s & IIf(Right(s, 1) = Application.PathSeparator, "", Application.PathSeparator)

Application.ScreenUpdating = False

Set fst = ThisWorkbook.Worksheets("Notes")
Set fso = CreateObject("Scripting.FileSystemObject")

GetSF s

Application.ScreenUpdating = True

Set SrcBook = Nothing
Set fso = Nothing
Set fst = Nothing
Set f = Nothing

MsgBox "Done!"
End Sub

Private Sub GetSF(path)
Dim SrcBook As Workbook
Set f = fso.GetFolder(path)

    For Each f1 In f.Files
        If Replace(f1.Name, fso.GetBaseName(f1), "") Like ".xls" Then
            Set SrcBook = Workbooks.Open(path & f1.Name)
            fst.Copy After:=SrcBook.Worksheets(SrcBook.Worksheets.Count)
            SrcBook.Close True
        End If
    Next
  
    For Each f In f.SubFolders
        GetSF f.path & Application.PathSeparator
    Next
End Sub

 

[Alex Blakenburg]

@prkhan56, @LazyBug's code worked fine for me so use that.
PS: I had to change xls to either xlsx or xls* in this line of the code If Replace(f1.Name, fso.GetBaseName(f1), "") Like ".xls" Then to get it to work and you will need to put it your own Folder path in s = "C:\Username\Macro\Test\"