Ausgewählte TB als xlsm und pdf speichern

Private Sub cmdOK_Click()
Dim arr() As String
Dim iRow As Integer, iCounter As Integer
Dim sPath As String
Dim sFilepdf As String, sFilexlsm As String
Application.ScreenUpdating = False
sPath = TextBox1.Text & "\"
sFilexlsm = TextBox2.Text & TextBox3.Text & ".xlsm"
sFilepdf = TextBox2.Text & TextBox3.Text & ".pdf"
For iRow = 0 To lstSheets.ListCount - 1
If lstSheets.Selected(iRow) Then
iCounter = iCounter + 1
ReDim Preserve arr(1 To iCounter)
arr(iCounter) = Worksheets(lstSheets.List(iRow)).Name
End If
Next iRow
Worksheets(arr).Copy
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs sPath & sFilexlsm, FileFormat:=xlOpenXMLWorkbookMacroEnabled,  _
CreateBackup:=False
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sPath & sFilepdf, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Application.DisplayAlerts = True
.Close savechanges:=False
End With
Application.ScreenUpdating = True
Unload Me
End Sub