السلام عليكم
جرب التعديل التالي
Sub sav_PDFall()
Dim i As Integer
Dim folderPath As String
Dim mainSheet As Worksheet
Dim tempWorkbook As Workbook
Dim firstRun As Boolean
Set mainSheet = ThisWorkbook.ActiveSheet
folderPath = ThisWorkbook.Path & "\ملاحظةالثانوية 2026"
firstRun = True
If Dir(folderPath, vbDirectory) = "" Then
MkDir folderPath
End If
Application.ScreenUpdating = False
For i = 1 To mainSheet.Range("j3").Value
mainSheet.Range("j2") = i
If firstRun Then
mainSheet.Copy
Set tempWorkbook = ActiveWorkbook
firstRun = False
Else
mainSheet.Copy After:=tempWorkbook.Sheets(tempWorkbook.Sheets.Count)
End If
Next i
tempWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=folderPath & "\كشف_جامع_" & mainSheet.Cells(2, 4).Text & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
tempWorkbook.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub