Sayın yyhy ekteki örnek bilmiyorum istediğinize uygun mu? İnceler misiniz?
"Dünyayı fazla düşünme."
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