dilerim işinize yarar
tek tek pdf kodu:

Baslik$ = "Yazdır."

Mesaj$ = "Belirlenen sayıya kadar yazdırılacak, Onaylıyormusunuz?"

cevap$ = MsgBox(Mesaj$, 4 + 32 + 0, Baslik$)

If cevap$ = 6 Then

Dim ilk As Integer

Dim son As Integer

Dim S1 As Worksheet

Dim S2 As Worksheet

Set S1 = Sheets("Sorgu")

Set S2 = Sheets("2")



ilk = S1.Range("E11").Value

son = S1.Range("J11").Value

For i = ilk To son

S1.Range("E3").Value = i

S2.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

        ActiveWorkbook.Path & "\" & i & "_hy.pdf", Quality:=xlQualityStandard, _

        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _

        False 'S2.PrintOut Copies:=1, Collate:=True

Next

MsgBox "Yazdırma İşlemi Gerçekleştirildi.", vbInformation, "Hazırlayan; Adli Büro "

End If



Set S1 = Nothing

Set S2 = Nothing

Toplu Pdf Kodu:

Baslik$ = "Yazdır."

Mesaj$ = "Belirlenen sayıya kadar yazdırılacak, Onaylıyormusunuz?"

cevap$ = MsgBox(Mesaj$, 4 + 32 + 0, Baslik$)

If cevap$ = 6 Then

Dim ilk As Integer

Dim son As Integer

Dim SonStr As Long

Dim S1 As Worksheet

Dim S2 As Worksheet

Dim TmpSHdf As Worksheet



Set S1 = Sheets("Sorgu")

Set S2 = Sheets("2")

'hy______________________________________

Application.ScreenUpdating = False

On Error GoTo ErrorHandler:



ThisWorkbook.Worksheets.Add.Name = "TmpSHdf"

Set TmpSHdf = Sheets("TmpSHdf")

ilk = S1.Range("E11").Value

son = S1.Range("J11").Value

SonStr = 0



For i = ilk To son

S1.Range("E3").Value = i

S2.Range("B1:J50").Copy

TmpSHdf.Range("A" & SonStr * 50 + 1).PasteSpecial xlPasteFormats

TmpSHdf.Range("A" & SonStr * 50 + 1).PasteSpecial xlPasteValuesAndNumberFormats

SonStr = SonStr + 1

Next

S2.Range("B1:J50").Copy

TmpSHdf.Range("A" & SonStr * 50 + 1).PasteSpecial xlPasteColumnWidths





TmpSHdf.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

        ActiveWorkbook.Path & "\" & ilk & "_" & son & "_Arası.pdf", Quality:=xlQualityStandard, _

        IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:= _

        False 'S2.PrintOut Copies:=1, Collate:=True



Application.DisplayAlerts = False

TmpSHdf.Delete

Application.DisplayAlerts = True



ErrorHandler:

Application.ScreenUpdating = True



'hy______________________________________

MsgBox "Yazdırma İşlemi Gerçekleştirildi.", vbInformation, "Hazırlayan; Adli Büro "

End If



Set S1 = Nothing

Set S2 = Nothing

Set TmpSHdf = Nothing