Sub PrintPDF()
Dim FileName As String, trSh As Worksheet, trRegSh As Worksheet, Docsht As Worksheet, destRow As Long
Dim testRow As Long, Nametest As Worksheet, n As Integer, m As Integer, r As Integer, i As Integer
Dim myRecipients As String, FPath As String, NameEase As String
destRow = 19
FPath = "C:\Users\rthomson\Desktop\"
With ThisWorkbook
Set trSh = .Sheets("Transmittal Sheet")
Set trRegSh = .Sheets("Transmittal Register")
End With
'save as pdf
FileName = trSh.Cells(12, "R")
trSh.ExportAsFixedFormat xlTypePDF, FileName:= _
FPath & FileName & ".pdf"
'move data from transmittal sheet to transmittal register
destRow = trRegSh.Cells(Rows.Count, 1).End(xlUp).row
For i = 12 To 15
'for each recipient
If Trim(trSh.Cells(i, "c")) = "" Then
Exit For
Else
If i > 12 Then
myRecipients = myRecipients & "; "
End If
myRecipients = myRecipients & trSh.Cells(i, "c")
End If
Next i
For r = 26 To 33
'for each document
If Trim(trSh.Cells(r, "h")) = "" Then
Exit For
End If
NameEase = trSh.Cells(r, "h")
Set Nametest = Sheets(NameEase)
testRow = Nametest.Range("B20", "N29").End(xlUp).row
destRow = destRow + 1
trRegSh.Cells(destRow, "b") = trSh.Cells(r, "f")
trRegSh.Cells(destRow, "c") = trSh.Cells(r, "h")
trRegSh.Cells(destRow, "d") = trSh.Cells(r, "j")
trRegSh.Cells(destRow, "e") = "DCC"
trRegSh.Cells(destRow, "f") = myRecipients
trRegSh.Cells(destRow, "g") = trSh.Cells(39, "R")
trRegSh.Cells(destRow, "h") = Date
trRegSh.Cells(destRow, "i") = trSh.Range("r40")
trRegSh.Hyperlinks.Add Anchor:=trRegSh.Cells(destRow, "a"), _
Address:=FPath & FileName & ".pdf", _
ScreenTip:="Click to open Transmittal", _
TextToDisplay:=FileName
testRow = testRow + 1
Nametest.Cells(testRow, "B") = trSh.Cells(12, "R")
Nametest.Cells(testRow, "E") = trSh.Cells(r, "f")
Nametest.Cells(testRow, "F") = myRecipients
Nametest.Cells(testRow, "K") = trSh.Cells(39, "R")
Nametest.Cells(testRow, "N") = Date
Next r
Set trSh = Nothing
Set trRegSh = Nothing
End Sub
Bookmarks