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
Preview:
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