i have a routine that saves specified sheets in a workbook to a pdf doc but if i make some of the sheets charts my routine falls over - vba

Question

The list of sheets is specified in the names range "SaveList", which takes some as worksheets and some as charts (full page ones) but it falls over with
run-time error 13 "type mismatch"
Routine code below
Sub SaveFile()
'Recalc Sheets prior to saving down
A = MsgBox("Do you want to Save the Performance Reports?", vbOKCancel)
If A = 2 Then Exit Sub
Dim SaveSheets As Variant
Dim strFilename As String
Dim sheetListRange As Range
Dim sheetName As Variant
Dim wksheet As Variant
Dim wkbSrc As Workbook
Dim wkbNew As Workbook
Dim wksNew As Worksheet
Dim wksSrc As Worksheet
Dim i As Integer
Dim OutApp As Object
Dim OutMail As Object
Dim v As Variant
Dim Jimmy As Variant
'On Error GoTo ErrorHandler
strFilename = Worksheets("Control").Range("SavePath").Value & "Ergonomie_Consultants_Performance_" & Format$(Now(), "YYYYMMDD") & ""
v = strFilename
Set sheetListRange = Worksheets("Control").Range("SaveList")
Set wkbSrc = ActiveWorkbook
Set wkbNew = Workbooks.Add
i = 0
For Each sheetName In sheetListRange
If sheetName = "" Then GoTo NEXT_SHEET
For Each wksheet In wkbSrc.Sheets
If wksheet.Name = sheetName Then
i = i + 1
wksheet.Copy Before:=wkbNew.Sheets(i)
Set wksNew = ActiveSheet
With wksNew
.Cells.Select
.Cells.Copy
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
End With
ActiveWindow.Zoom = 75
GoTo NEXT_SHEET
End If
Next wksheet
NEXT_SHEET:
Next sheetName
Application.DisplayAlerts = False
'dont need the default new sheets created by created a new workbook
wkbNew.Worksheets("Sheet1").Delete
ActiveWorkbook.SaveAs Filename:=v, FileFormat:=xlNormal
If VarType(v) <> vbString Then Exit Sub
If Dir(v) <> "" Then
If MsgBox("File already exists - do you wish to overwrite it?", vbYesNo, "File Exists") = vbNo Then Exit Sub
End If
With ActiveWorkbook
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=v, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=False
End With
' ActiveWorkbook.Close
' EMAIL Attachment File
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "waverley.inc#gmail.com"
' .CC = ""
' .BCC = ""
.Subject = "Report" & Format$(Now(), "_YYYYMMDD")
.Body = "DRAFT PLEASE REVIEW :Consultant Report" & Format$(Now(), "_YYYYMMDD")
.Attachments.Add v & ".pdf"
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = True
ActiveWorkbook.Close
Exit Sub
ErrorHandler:
'If there is an unknown runtime error give the user the error number and associated description
'(Description is already set if the erorr is G_LNG_CRITICAL_ERROR)
If Err.Number <> CRITICAL_ERROR Then Err.Description = "Run-time error " & Err.Number & ": " & Err.Description
Err.Description = "Error saving worksheet as file: " & Err.Description
Err.Source = "Error saving worksheet as file: " & Err.Source
'Raise the error up to the error handler above
Err.Raise Number:=CRITICAL_ERROR
End Sub

Answer 1

Try the section of code below instead of your 2 x For Each loops.
using Application.Match to find if the Sheet.Name is found within sheetListRange array (values read from Named Range "SaveList").
Dim sheetListRange As Variant
' instead of saving the Range, save the values inside the Range in an Array
sheetListRange = Application.Transpose(Worksheets("Control").Range("SaveList"))
Set wkbSrc = ActiveWorkbook
Set wkbNew = Workbooks.Add
i = wkbNew.Sheets.Count
For Each wksheet In wkbSrc.Sheets
' instead of 2 X loops, use Application.Match
If Not IsError(Application.Match(wksheet.Name, sheetListRange, 0)) Then ' worksheet match in "SaveList" Named Range
wksheet.Copy Before:=wkbNew.Sheets(i)
If Not wksheet.CodeName Like "Chart*" Then ' if current sheet is not type Chart
Set wksNew = ActiveSheet
With wksNew
.Cells.Copy
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
End With
End If
i = i + 1
ActiveWindow.Zoom = 75
End If
Next wksheet