Sub CreateValueFile() Dim wbCurr As Workbook, wbOut As Workbook Dim sName As String Dim sSheet As Worksheet, CurSheet As Worksheet Dim strFileExists As String Application.DisplayAlerts = False Application.ScreenUpdating = False Application.EnableEvents = False 'To avoid problems with Titus Set wbCurr = ThisWorkbook 'Copy output template to output file sName = "C:\Users\ah19053\Aon\Bosch 2022 Global Actuary RFP - Central documents\040. Local fee collection\Bosch_2022_Fees_Template_v01.xlsx" Set wbOut = Workbooks.Open(Filename:=sName, UpdateLinks:=0) sName = "C:\Users\ah19053\Aon\Bosch 2022 Global Actuary RFP - Central documents\040. Local fee collection\Bosch_2022_Fees_v01.xlsx" strFileExists = Dir(sName) If strFileExists = "" Then Else Kill sName End If On Error GoTo 0 wbOut.SaveAs Filename:=sName 'loop through worksheets For Each sSheet In wbCurr.Worksheets If InStr(1, sSheet.Name, "Pricing") > 0 Then sSheet.Copy after:=wbOut.Sheets(wbOut.Sheets.Count) wbOut.Sheets(wbOut.Sheets.Count).Select Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("a1").Select 'Set CurSheet = wbOut.Sheets.Add 'Debug.Print sSheet.Name End If Next sSheet wbOut.Save Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox ("Program finished") End Sub