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
Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.
”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.