asked on
Sub Insertworksheet()
Dim path As String
Dim file As String
Dim wkbk As Workbook
Dim rCell As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
path = "C:\pathname\*"
file = Dir(path)
Do While Not file = ""
Application.DisplayAlerts = False
Workbooks.Open (path & file)
Set wkbk = ActiveWorkbook
Sheets.Add After:=Sheets(Sheets.Count)
On Error GoTo Sheet_Exists
ActiveSheet.Name = "DB Output"
On Error GoTo 0
ThisWorkbook.Sheets("DBOutput").Range("A1:B335").Copy Destination:=wkbk.Sheets("DB Output").Range("A1")
For Each rCell In wkbk.Sheets("DB Output").UsedRange
If InStr(rCell.Formula, ThisWorkbook.Name) > 0 Then
' rCell.Replace What:="[*]", Replacement:=""
rCell.Replace What:="'*!'", Replacement:="WORKSHEET!"
End If
' Sheets("DBOutput").Visible = False
Next
wkbk.Save
wkbk.Close
file = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
Sheet_Exists:
Sheets("DB Output").Delete
' Sheets("DB Output").Save
Resume
End Sub