Sub test()

Set shablon = ThisWorkbook.Sheets("Shablon")
shablon.Copy after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)

End Sub

Sub lisichka2009()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set shablon = ThisWorkbook.Sheets("Shablon")

Dim sName As String

sName = Dir("c:\!!\*.xls")

Do While sName <> ""
Set target = Workbooks.Open(Filename:="c:\!!\" & sName, ReadOnly:=False)
shablon.Copy after:=target.Sheets(ActiveWorkbook.Sheets.Count)
Application.StatusBar = " Working On File " & sName ' визуализация работы
target.SaveAs "c:\!!\" & sName
target.Close
sName = Dir
Loop

Application.StatusBar = False 'сбрасываем визуализацию работы
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub