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

 

[lhartono]

Try this.....
The code can be shorten later.

[SIZE=2][FONT=lucida console][COLOR=#0000cd]Sub prtdata()
Dim arrData
Dim arrHello
Dim lastRow     As Long
Dim rowNow      As Long
Dim strPath     As String
Dim strPDF      As String

lastRow = Sheets("data").Range("A" & Rows.Count).End(xlUp).Row

If lastRow < 3 Then
    MsgBox "   No data to save.   ", vbCritical + vbOKOnly, " Notification"
    Exit Sub
End If

strPath = "D:\Test" & "\"

Sheets("Hello").Range("E7,D9:D16,H9").ClearContents

For rowNow = 3 To lastRow
    strPDF = strPath & Sheets("data").Range("A" & rowNow) & ".pdf"
    With Sheets("data")
        .Range("A" & rowNow).Copy Destination:=Sheets("Hello").Range("E7")
        .Range("B" & rowNow).Copy Destination:=Sheets("Hello").Range("D9")
        .Range("C" & rowNow).Copy Destination:=Sheets("Hello").Range("D10")
        .Range("D" & rowNow).Copy Destination:=Sheets("Hello").Range("D11")
        .Range("E" & rowNow).Copy Destination:=Sheets("Hello").Range("D12")
        .Range("F" & rowNow).Copy Destination:=Sheets("Hello").Range("D13")
        .Range("G" & rowNow).Copy Destination:=Sheets("Hello").Range("D14")
        .Range("H" & rowNow).Copy Destination:=Sheets("Hello").Range("D15")
        .Range("I" & rowNow).Copy Destination:=Sheets("Hello").Range("D16")
        .Range("J" & rowNow).Copy Destination:=Sheets("Hello").Range("H9")
    End With
    Worksheets("Hello").Range("B4:I20").ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=False, Filename:=strPDF
    Sheets("Hello").Range("E7,D9:D16,H9").ClearContents
Next

End Sub[/COLOR][/FONT][/SIZE]

 

[Fluff]

Another option

Sub prtdata()

   Dim strPath As String
   Dim Cnt As Long
   Dim UsdRws As Long
   
   strPath = "D:\Test\"
   With Sheets("data")
      UsdRws = .Range("A" & Rows.Count).End(xlUp).Row
      If UsdRws < 3 Then
         MsgBox "No Data"
         Exit Sub
      End If
      
      For Cnt = 3 To UsdRws
         Sheets("Hello").Range("E7,D9:D16,H9").ClearContents
         Sheets("Hello").Range("E7").Value = .Range("A" & Cnt).Value
         Sheets("Hello").Range("e9:e16").Value = Application.Transpose(.Range("B" & Cnt).Resize(, 8).Value)
         Sheets("Hello").Range("H9").Value = .Range("J3").Value
      
         Sheets("Hello").Range("B4:I20").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            FileName:=strPath & .Range("A" & Cnt).Value & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
      Next Cnt
   End With

End Sub

 

[gokulu]

Thanks for the code, still i need some modification in pdf output, Since the data is less, i need to get two set of data's in single page pdf. For second set of data i had assigned cells as below in sheet hello.
E26,D28,D29,D30,D31,D32,D33,D34,D35,H28,H26
Worksheets("Hello").Range("B23:I39")

 

[Fluff]

Not sure if I've understood you correctly, but try changing this

Sheets("Hello").Range("B4:I20").ExportAsFixedFormat

to

Sheets("Hello").Range("B4:I39").ExportAsFixedFormat