پرسش پی دی اف گرفتن از 6 شیت با زدن یک کیلد(6 فایل پی دی اف جداگانه)

[احسان رنجبر]

با سلام
من یک فایل اکسل دارم که از چندین شیت تشکیل شده
و میخوام با زدن یک کلید، از 6 شیت به صورت همزمان فایل پی دی اف بهم بده
در حال حاضر توی هر شیت یک کلید گذاشتم که با زدن اون خروجی پی دی اف رو میده
ولی میخوام برای هر 6 تا شیت به صورت همزمان و فایل های چداگانه خروجی بده
در انتها کدی که باهاش پی دی اف تکی میگیرم رو گذاشتم
ممنون میشم راهنمایی کنید
-----------------------
Sub printR()
Dim ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
On Error GoTo errHandler
Set ws = ActiveSheet
strFile = Replace(Replace(ws.Name, " ", ""), ".", "_") _
& "-" _
& Range("C5") _
& "(" _
& Range("D6") _
& " " _
& Range("G6") _
& " " _
& Range("k6") _
& ")" _
& ".pdf"
strFile = ThisWorkbook.Path & "" & strFile

myFile = Application.GetSaveAsFilename _
(InitialFileName:=strFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="ãÓíÑ æ äÇã ÝÇíá ÑÇ ÌåÊ ÐÎíÑå ÓÇÒí ãÔÎÕ äãÇÆíÏ")

If myFile <> "False" Then
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

MsgBox ".ÝÇíá ÈÇ ãæÝÞíÊ ÇíÌÇÏ ÑÏíÏ"
End If

exitHandler:
Exit Sub
errHandler:
MsgBox "ÎØÇ ÏÑ ÇíÌÇÏ ÝÇíá"
Resume exitHandler
End Sub

[mokaram]

با سلام ضمن عرض خیر مقدم
از این کد استفاده کنید :

Sub exportPDF()
Dim Folder_Path As String
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "مقصد فایل را مشخص کنید"
    If .Show = -1 Then Folder_Path = .SelectedItems(1)
End With
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
    sh.ExportAsFixedFormat xlTypePDF, Folder_Path & Application.PathSeparator & sh.Name & ".pdf"
Next
MsgBox "عملیات با موفقیت انجام شد", vbOKOnly
End Sub 

[احسان رنجبر]

با سلام ضمن عرض خیر مقدم
از این کد استفاده کنید :

Sub exportPDF()
Dim Folder_Path As String
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "مقصد فایل را مشخص کنید"
    If .Show = -1 Then Folder_Path = .SelectedItems(1)
End With
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
    sh.ExportAsFixedFormat xlTypePDF, Folder_Path & Application.PathSeparator & sh.Name & ".pdf"
Next
MsgBox "عملیات با موفقیت انجام شد", vbOKOnly
End Sub 

خیلی ممنونم
لطف کردید
فقط یک مشکلی هست اونم این که من از بین 16 تا شیتی که دارم فقط از 6تاش میخوام خروجی بگیرم ولی این کد از همه شیت ها خروجی میگیره
و ضمن اینکه برای اسم هر فایل میخوام عنوان شیت + یک عبارت از یک سلول در همان شیت استفاده شود(درحالی که این کد که فرستادید عنوان هرشیت رو برای عنوان فایل پی دی اف استفاده میکنه. خوب هست ولی ناقص)