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

[tnacius rottie]

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?

 

[BrianB]

Not exactly what you want but the principle is the same :-

http://www.mrexcel.com/forum/showthread.php?t=140187

 

[tnacius rottie]

This is what I have come up with but it keeps giving me an error when I try to "Activate" the sheet that has data on it (not the template) before I save the file.

Sub Open_Add_SheetTemplate()
    Dim path As Variant
    Dim excelfile As Variant
    path = "D:\E-drive\Test\Zmacrotesting\"
    excelfile = Dir(path & "*.xls")
    Application.DisplayAlerts = False
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim shName As String
    Dim n As Integer
 
    'Name of the sheet template
    shName = "D:\E-drive\Test\ADD.xls"
 
    Do While excelfile <> ""
        Workbooks.Open Filename:=path & excelfile
 
        'Insert sheet template
        With ThisWorkbook
        Set sh = Sheets.Add(Type:=shName, After:=.Sheets(.Sheets.Count))
        Worksheet.Activate ("Sheet1")    'Run Time Error 424: Object Required'
        .Save
        .Close
    End With
 
    excelfile = Dir
 
    Loop
End Sub

I have modified the line of code to all kinds of things and get all kinds of different errors. I am trying so hard to achieve above and beyond because that is just what I do..........tenacious......persistent......

Thank you for your consideration and all the help provided by other posts!!!

 

[Weaver]

Instead of

Worksheet.Activate ("Sheet1")

have you tried sh.activate

?
</pre>

 

[xlhth]

Try

Sub test()
    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("add")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.Getfolder("D:\E-drive\Test\Zmacrotesting\")
    Set ff = f.Files
 
    For Each f1 In ff
        Set SrcBook = Workbooks.Open(f1)
        'object reference
        fst.Copy After:=SrcBook.Worksheets(1)
        'copy template sheet
        SrcBook.Worksheets(1).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

Modified code provided by GNaga in http://www.mrexcel.com/forum/showthread.php?t=49155

 

[jindon]

Not sure what you are after...

Sub test()
Dim myDir As String, fn As String, wsTemp As Worksheet
myDir = "D:\E-drive\Test\Zmacrotesting\"
Set wsTemp = Thisworkbook.Sheets("add")  '<- not quite sure...
fn = Dir(myDir & ".xls")
Do While fn <> ""
    If fn <> ThisWorkbook.Name Then
        With Workbooks.Open(myDir & fn)
            wsTemp.Copy after = .Sheets(.Sheets.Count)
            .Close True
        End With
    End If
    fn = Dir
Loop
End Sub

 

[tnacius rottie]

TO: xlhth:

I just tried your code!!!! (I took vacation last week) and it works wonderfully! Thank you so much you are a life saver!

Yippee!!!!