Export data to PDF format with multiple rows.

[gokulu]

I am new to Excel VBA
Still I had created an macro that work as I need.
In an workbook I had two sheets(data and hello) so data's are in data sheet and print format is in hello sheet, Please find the below code which is working and the pdf is saving. But this code is only for two rows, Kindly share the code that will export more than 20 rows.

Sub prtdata()
Dim cell As Range, strPath As String
strPath = "D:\Test"
Sheets("data").Range("A3").Copy Destination:=Sheets("Hello").Range("E7")
Sheets("data").Range("B3").Copy Destination:=Sheets("Hello").Range("D9")
Sheets("data").Range("C3").Copy Destination:=Sheets("Hello").Range("D10")
Sheets("data").Range("D3").Copy Destination:=Sheets("Hello").Range("D11")
Sheets("data").Range("E3").Copy Destination:=Sheets("Hello").Range("D12")
Sheets("data").Range("F3").Copy Destination:=Sheets("Hello").Range("D13")
Sheets("data").Range("G3").Copy Destination:=Sheets("Hello").Range("D14")
Sheets("data").Range("H3").Copy Destination:=Sheets("Hello").Range("D15")
Sheets("data").Range("I3").Copy Destination:=Sheets("Hello").Range("D16")
Sheets("data").Range("J3").Copy Destination:=Sheets("Hello").Range("H9")
If Worksheets("Data").Range("A3").Value = "" Then
MsgBox "End OF the REport"
Range("A3").Select
Exit Sub
Else
Worksheets("Hello").Range("B4:I20").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPath & Worksheets("Data").Range("A3").Value & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Sheets("data").Range("A4").Copy Destination:=Sheets("Hello").Range("E7")
Sheets("data").Range("B4").Copy Destination:=Sheets("Hello").Range("D9")
Sheets("data").Range("C4").Copy Destination:=Sheets("Hello").Range("D10")
Sheets("data").Range("D4").Copy Destination:=Sheets("Hello").Range("D11")
Sheets("data").Range("E4").Copy Destination:=Sheets("Hello").Range("D12")
Sheets("data").Range("F4").Copy Destination:=Sheets("Hello").Range("D13")
Sheets("data").Range("G4").Copy Destination:=Sheets("Hello").Range("D14")
Sheets("data").Range("H4").Copy Destination:=Sheets("Hello").Range("D15")
Sheets("data").Range("I4").Copy Destination:=Sheets("Hello").Range("D16")
Sheets("data").Range("J4").Copy Destination:=Sheets("Hello").Range("H9")
If Worksheets("Data").Range("A4").Value = "" Then
MsgBox "End OF the REport"
Range("A4").Select
Exit Sub
Else

Worksheets("Hello").Range("B4:I20").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPath & Worksheets("Data").Range("A4").Value & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

End If
End If
End Sub

 

[Youngdand]

HI,

Sorry i dont currently have time to write it out, but essentially what you want to do, is make the row number for "Data".range a variable starting at 3 eg x=3, change the copy sections to

Sheets("data").Range("A"&x).Copy Destination:=Sheets("Hello").Range("E7")

then put the data copy and export pdf function in to a loop , and increase the x by 1 at the the end after the pdf is written, then test to see if range("a"&x) is "", if so stop, if not next.

If i am about later i will try to provide the code, but hopefully this will help you.

 

[gokulu]

Hi

Thanks MAN its working perfectly what I expected..

Final working code below:
Sub prtdata()
Dim cell As Range, strPath As String
Dim x As Integer
strPath = "D:\Test"
x = 3
Do
Sheets("data").Range("A" & x).Copy Destination:=Sheets("Hello").Range("E7")
Sheets("data").Range("B" & x).Copy Destination:=Sheets("Hello").Range("D9")
Sheets("data").Range("C" & x).Copy Destination:=Sheets("Hello").Range("D10")
Sheets("data").Range("D" & x).Copy Destination:=Sheets("Hello").Range("D11")
Sheets("data").Range("E" & x).Copy Destination:=Sheets("Hello").Range("D12")
Sheets("data").Range("F" & x).Copy Destination:=Sheets("Hello").Range("D13")
Sheets("data").Range("G" & x).Copy Destination:=Sheets("Hello").Range("D14")
Sheets("data").Range("H" & x).Copy Destination:=Sheets("Hello").Range("D15")
Sheets("data").Range("I" & x).Copy Destination:=Sheets("Hello").Range("D16")
Sheets("data").Range("J" & x).Copy Destination:=Sheets("Hello").Range("H9")
If Worksheets("Data").Range("A" & x).Value = "" Then
MsgBox "End OF the REport"
Range("A" & x).Select
Exit Sub
Else
Worksheets("Hello").Range("B4:I20").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPath & Worksheets("Data").Range("A" & x).Value & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
x = x + 1
Loop
End Sub