Good afternoon all!
I'll try to explain this as clearly as possible.
I'm trying to design a macro to copy specific information from cells on one sheet to another. However the Macro has to select which sheet to copy the data to from the data on the first sheet.
So say the first sheet has document number, name, revision, date, transmittal no. etc. The macro would copy the revision, date and transmittal no. to (Document Number Sheet)
Apologies in advance for this code, because it also functions already to create a pdf, save info in another sheet and create a hyperlink to pdf, this was just the most functional place to insert the code. I've highlighted the specific bits I'm working on in red. The main rpoblem I'm having is setting the worksheet based on a value from a cell without using a heap of preprogrammed IF statements to pick for me.
Any help would be greatly appreciated!
Sub PrintPDF()
Dim FileName As String
Dim trSh As Worksheet
Dim trRegSh As Worksheet
Dim Docsht As Worksheet
Dim destRow As Long
Dim testRow As Long
Dim Nametest As Worksheet
Dim NameEase As String
Dim r As Integer, i As Integer
Dim myRecipients As String
Dim FPath As String
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
testRow = Nametest.Cells(20, 2).End(x1Up).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")
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