الكود من عمل الاستاذ  الرائد   اريد من خلاله طباعة 3 اوراق عمل فقط الى pdf وليس كل الصفحات لتعذر حذف بعض الثفحات 
 
Sub pdfcopy2()
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lOver As Long
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strPath = ThisWorkbook.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
For i = 1 To Sheets.Count
If i <> "" Then
strName = i & "-" & Sheets(i).Name & "-" & ActiveSheet.Range("b3").Value
strFile = strName & ".pdf"
strPathFile = strPath & strFile
If bFileExists(strPathFile) Then
  lOver = MsgBox("الملف موجود مسبقا.هل تريد استبداله؟", _
    vbQuestion + vbYesNo, "ملف موجود")
  If lOver <> vbYes Then
    myFile = Application.GetSaveAsFilename _
      (InitialFileName:=strPathFile, _
          FileFilter:="PDF Files (*.pdf), *.pdf", _
          Title:="إختيار مجلد الحفظ")
    If myFile <> "False" Then
      strPathFile = myFile
    Else
      GoTo exitHandler
    End If
  End If
End If
wsA.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=strPathFile, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
End If
Next i
MsgBox "تم إنشاء الملف بإسم المعني: " & vbCrLf & strPathFile
errHandler:
    Resume exitHandler
exitHandler:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub
	 
	17.xlsm