tüm sayfalarda aynı hücreleri toplu pdf olarak kaydetme

[SMSKMHMMT]

Herkese merhabalar kolay gelsin,
çok sayfalı bir excel dosyasında her sayfanın am1;az41 hücreleri aralığını pdf olarak masaüstünde yeni klasör diye bir klasöre her sayfanın kendi ismi ile ayrı ayrı kaydetmek istiyorum. makro kaydederek bir şekilde her sayfada buton koyarak bir miktar kolaylaştırdım ama böyle bir makro var mıdır?
Şimdiden teşekkür ederim.

 

[okan32]

Deneyiniz.

Sub HerSayfayiPDFKaydet()
        Dim ws As Worksheet
    Dim folderPath As String
    Dim fileName As String
   
  
    folderPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Yeni Klasör\"
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
    End If
   

    For Each ws In ThisWorkbook.Sheets
      
        fileName = folderPath & ws.Name & ".pdf"
       
       
        ws.Range("AM1:AZ41").ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileName, Quality:=xlQualityStandard
       
      
        MsgBox ws.Name & " sayfası PDF olarak kaydedildi.", vbInformation
    Next ws
End Sub

 

[SMSKMHMMT]

teşekkürler hocam lakin hata alıyorum 1004 normal vba da hata veriyor makro olarak atadığımda da 400 hatası veriyor.

 

[okan32]

Bunu deneyin

Sub ExportPagesToPDF()
    Dim ws As Worksheet
    Dim folderPath As String
    Dim fileName As String
    Dim exportRange As Range
        
    folderPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Yeni Klasör\"
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
    End If
    
    
    Set exportRange = Range("AM1:AZ41")
    
    
    For Each ws In ThisWorkbook.Sheets
        
        fileName = folderPath & ws.Name & ".pdf"
        
      
        ws.Select ' Sayfayı seç
        exportRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileName, Quality:=xlQualityStandard
        
      
        MsgBox ws.Name & " sayfası PDF olarak kaydedildi.", vbInformation
    Next ws
End Sub

 

[SMSKMHMMT]

teşekkür ederim çalıştı konu ile çok alakalı değil bir çok yerde farklı şekillerde yazılmış bir konu tekrar konu açmak istemedim f sutununda bir isim listesi var aynı isimlerle açılmış sayfalar var toplu halde köprü yapmak istiyorum sadece başka konularda sırala dosyadan köprü kur gibi şeyler var forum kurallarını bozmuyorsam yardımcı olur musunuz?

 

[okan32]

Size bir fikir verebilir kendine göre uyarla

Sub kopruolustur()
    Dim wsSource As Worksheet
    Dim rngNames As Range
    Dim cell As Range
    Dim wsTarget As Worksheet
    Dim nameRange As Range
         Set wsSource = ThisWorkbook.Sheets("Sayfa1")
           Set rngNames = wsSource.Range("F:F").SpecialCells(xlCellTypeConstants)
      
    For Each cell In rngNames
               On Error Resume Next
        Set wsTarget = ThisWorkbook.Sheets(cell.Value)
        On Error GoTo 0
              
        If Not wsTarget Is Nothing Then
            
            Set nameRange = wsSource.Range("F" & cell.Row)
            wsSource.Hyperlinks.Add Anchor:=nameRange, Address:="", SubAddress:="'" & wsTarget.Name & "'!A1", TextToDisplay:=cell.Value
        End If
    Next cell
End Sub

 

[SMSKMHMMT]

çok teşekkür ederim.