• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro editing for pdf's creation (one file each row)

SbusyCR

New Member
Hi Champions!

I would like to know how I have to edit the Macro so that a pdf for each row is created.

File is attached.
 

Attachments

  • excel to pdf.xlsm
    19.2 KB · Views: 3
I attach the correct file and the Macro edit query is:

  1. for each row
  2. the pdf file name as per column A, example Steve B.pdf
 

Attachments

  • excel to pdf.xlsm
    19.2 KB · Views: 4
Hi SbusyCR,
try this code:
Code:
Sub FilterAndSavePDF()

    Dim cell   As Range
    Dim LastRow As Integer
    Dim MyPath As String, MyFile As String
    Dim DataRange As Range


    MyPath = "D:\STECMATOURS\" '========>> Adapt the path
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Set DataRange = ActiveSheet.Range("A1:H" & LastRow)
    Application.ScreenUpdating = False
    
    For Each cell In Range("A2:A" & LastRow)
        DataRange.AutoFilter Field:=1, Criteria1:=cell
        
        MyFile = cell.Value
        DataRange.ExportAsFixedFormat Type:=xlTypePDF, FileName:=MyPath & MyFile _
                                      , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                                      :=False, OpenAfterPublish:=False
        
    Next cell
    
    ActiveSheet.ShowAllData
    
    Application.ScreenUpdating = True
        
End Sub
 
Hi Keetoowah, thanks for the input? File names solved. However, column A is still present and the last column went to the second page
 
Last edited by a moderator:
Hi SbusyCR,
see if the following code does what you require:
Code:
Sub FilterAndSavePDF2()

    Dim Ws     As Worksheet
    Dim cell   As Range
    Dim LastRow As Integer
    Dim MyPath As String, MyFile As String
    Dim DataRange As Range

    Set Ws = ThisWorkbook.Sheets("Sheet1")
    MyPath = "D:\STECMATOURS\"                    '========>> Adapt the path
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Set DataRange = Ws.Range("A1:H" & LastRow)
    Application.ScreenUpdating = False
    
    For Each cell In Range("A2:A" & LastRow)
        DataRange.AutoFilter Field:=1, Criteria1:=cell
        
        MyFile = cell.Value
        
        With Ws.PageSetup
            .PrintArea = Ws.Range("B1", Range("H" & Rows.Count).End(xlUp)).Address
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
        
        Ws.ExportAsFixedFormat Type:=xlTypePDF, FileName:=MyPath & MyFile _
                               , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                               :=False, OpenAfterPublish:=False
        
    Next cell
    
    With Ws
        .ShowAllData
        .PageSetup.PrintArea = ""
    End With
        
    Application.ScreenUpdating = True
    
End Sub
 
Back
Top