Nee Loop Function to copy from one sheet and paste in other sheet and then expor

Question

Nee Loop Function to copy from one sheet and paste in other sheet and then export in PDF for each row

Hi,

My requirement is that I want to take a cell value from one sheet called "Details" and put in another sheet called "Report" , Now I want to export that report in PDF for each row, here is details from sheet "Details" for that I need loop function:

Here is the code I have written :

Sub inspectionreportprint()
'
' inspectionreportprint Macro
'
' Keyboard Shortcut: Ctrl+Shift+P

Dim cellref As String

cellref = Worksheets("details").Range("c5").Offset(0, 18).Value

If cellref <> "Printed" Then

Worksheets("report").Activate

Range("j5").Value = Year(yy) & Month(mm) & Worksheets("details").Range("c5").Value

Range("j6").Value = Date

Range("d11").Value = Worksheets("details").Range("d5").Value ' (I need this to change for each row after print)

Range("d12").Value = Worksheets("details").Range("e5").Value (I need this to change for each row after print)

Range("d13").Value = Worksheets("details").Range("f5").Value (I need this to change for each row after print)

Range("d14").Value = Worksheets("details").Range("g5").Value (I need this to change for each row after print)

Range("d15").Value = Worksheets("details").Range("h5").Value (I need this to change for each row after print)

Range("d16").Value = Worksheets("details").Range("i5").Value (I need this to change for each row after print)

Range("j11").Value = Worksheets("details").Range("k5").Value (I need this to change for each row after print)

Range("j13").Value = Worksheets("details").Range("j5").Value (I need this to change for each row after print)

Range("b20").Value = Worksheets("details").Range("l5").Value (I need this to change for each row after print)

Range("d29").Value = Worksheets("details").Range("m5").Value (I need this to change for each row after print)

Range("d30").Value = Worksheets("details").Range("n5").Value (I need this to change for each row after print)

Range("d31").Value = Worksheets("details").Range("o5").Value (I need this to change for each row after print)

Range("d32").Value = Worksheets("details").Range("p5").Value (I need this to change for each row after print)

Range("j13").Value = Worksheets("details").Range("j5").Value (I need this to change for each row after print)

Range("d38").Value = Environ("UserName")

ElseIf cellref = "Printed" Then

End If

Call printinpdf

End Sub
Sub printinpdf()
'
' printinpdf Macro
'
' Keyboard Shortcut: Ctrl+Shift+O
'
Dim contno As Strring
Dim printedgrn As String
Dim cellref As String

Name = Environ("UserName")




contno = Sheeets("report").Range("d11").Value

Worksheets("report").Activaate

ActiveSheet.ExportAssFixedFormat Type:=xlTypePDF, Filename:="C:Users" & Name & "Desktop" & contno, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

Worksheets("details").Range("c5").Offset(0, 18).Value = "Printed"

'End If

End Subbb!!

Serial No. Contaienr NO. Shipping Line Depot Tare Weight Payload Seal No. Weight Qulaity Item Description Supplier yard Date In Date Out Inspector Photo taken Status 1 ABCD 1234567 SHIP A 2.280 28.200 1234567 25.000 H Description 1 supplier 1 supp1a 17-Aug 29-Aug Printed 1 ABCD 2454755 SHIP A 2.280 28.200 1234567 25.000 H Description 1 supplier 2 supp1b 17-Aug 29-Aug 1 ABCD 9876541 SHIP A 2.280 28.200 1234567 25.000 H Description 1 supplier 3 supp1c 17-Aug 29-Aug 1 ABCD 3232456 SHIP A 2.280 28.200 1234567 25.000 H Description 1 supplier 4 supp1d 17-Aug 29-Aug 1 ABCD 2255445 SHIP A 2.280 28.200 1234567 25.000 H Description 1 supplier 5 supp1e 17-Aug 29-Aug

Explanation / Answer

Hi,

Try this:

Sub InspectionReportPrint()
' Keyboard Shortcut: Ctrl+Shift+P
'
    Dim lnLastRow As Long, i As Long
    Dim wsDetails As Worksheet, wsReport As Worksheet
    Dim strContNo As String, strName As String
    Dim yy As String, mm As String
    
    Set wsDetails = Worksheets("details")
    Set wsReport = Worksheets("report")
    
    lnLastRow = wsDetails.Cells(wsDetails.Rows.Count, "A").End(xlUp).Row
    yy = Format(Date, "yy")
    mm = Format(Date, "mm")
    strName = Environ("UserName")
    
    wsReport.Range("J6").Value = Date
    
    For i = 2 To lnLastRow
        If wsDetails.Range("Q" & i).Value <> "Printed" Then
            strContNo = wsDetails.Range("B" & i).Value
            
            wsReport.Range("J5").Value = yy & mm & wsDetails.Range("C" & i).Value
            wsReport.Range("D11").Value = strContNo
            wsReport.Range("D12").Value = wsDetails.Range("E" & i).Value
            wsReport.Range("D13").Value = wsDetails.Range("F" & i).Value
            wsReport.Range("D14").Value = wsDetails.Range("G" & i).Value
            wsReport.Range("D15").Value = wsDetails.Range("H" & i).Value
            wsReport.Range("D16").Value = wsDetails.Range("I" & i).Value
            wsReport.Range("J11").Value = wsDetails.Range("K" & i).Value
            wsReport.Range("J13").Value = wsDetails.Range("J" & i).Value
            wsReport.Range("B20").Value = wsDetails.Range("L" & i).Value
            wsReport.Range("D29").Value = wsDetails.Range("M" & i).Value
            wsReport.Range("D30").Value = wsDetails.Range("N" & i).Value
            wsReport.Range("D31").Value = wsDetails.Range("O" & i).Value
            wsReport.Range("D32").Value = wsDetails.Range("P" & i).Value
            wsReport.Range("J13").Vaalue = wsDetails.Range("J" & i).Value
            wsReport.Range("D38").Value = strName
            
            'Export to PDF:
            wsReport.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:="C:Users" & strName & "Desktop" & strContNo, _
                Quality:=xlQualityStaandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPuublish:=True
            
            wsDetails.Raange("Q" & i).Value = "Printed"
        End If
    Next i
End Subbb!

Related Questions

Navigate

• Browse (All)
• Browse N
• Subjects

---

---

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.