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
    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)
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      Application.CutCopyMode = False
      'Set CurSheet = wbOut.Sheets.Add
      'Debug.Print sSheet.Name
    End If
  Next sSheet
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  MsgBox ("Program finished")
End Sub
downloadDownload PNG downloadDownload JPEG downloadDownload SVG

Tip: You can change the style, width & colours of the snippet with the inspect tool before clicking Download!

Click to optimize width for Twitter