DA2062.vb

Sub MyMacro()
    If MsgBox("This function will create a separate PDF file for every name you input in the To column (each PDF file will take approximately 1 second to create). Are you sure you want to continue?", _
            vbYesNo + vbQuestion) = vbNo Then
        Exit Sub
        
    End If
    Dim srcSht As Worksheet, destSht As Worksheet
    Dim lastRow As Long
    Dim cel As Range, rng As Range

    Set srcSht = ThisWorkbook.Sheets("Data")
    Set destSht = ThisWorkbook.Sheets("DA2062")

    With srcSht
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Each cel In .Range("A2:A" & lastRow)
            cel.Copy destSht.Range("R1")
            cel.Offset(0, 1).Copy destSht.Range("J7")

            Set rng = Union(destSht.Range("R1"), destSht.Range("J7"))

            With rng.Font
                .Name = "Calibri"
                .Size = 20
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ThemeColor = xlThemeColorLight1
                .TintAndShade = 0
                .ThemeFont = xlThemeFontMinor
            End With
            
            With rng
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlCenter
                .WrapText = False
            End With

            destSht.Range("I7").Font.Size = 16

            ThisWorkbook.Sheets("DA2062").ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=ThisWorkbook.Path & "\" & (cel.Row - 1) & ".pdf", _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=True, _
                OpenAfterPublish:=False
        Next cel
    End With
End Sub