Boa tarde!

Só uma dúvida seu código está salvando um arquivo para cada linha parece é isso mesmo que você quer?

Experimente utilizar sua rotina assim:

Sub BarraDeProgresso()
Dim Wmap As Worksheet
Dim Arq As String
Dim i               As Long
Dim iUltimaLinha    As Long
Dim iPercentualConcluido As Double
    
    Application.ScreenUpdating = False
    
'   iUltimaLinha = Sheets("Dados").Range("A" & Rows.Count).End(xlUp).Row
    iUltimaLinha = Sheets("Dados").Range("A1").End(xlDown).Row
Set Wmap = Sheets("Relatorio")
    
    frmBarraDeProgresso.Show False
    
    For i = 2 To iUltimaLinha
        iPercentualConcluido = i / iUltimaLinha
        With frmBarraDeProgresso
            .framePb.Caption = Format(iPercentualConcluido, "0%") & " Concluído"
            .progressBar.Width = iPercentualConcluido * (.framePb.Width - 10)
        End With
        
        DoEvents    'Permite que sejam visualizadas as mudanças nos controles do formulário
        
        'Call GravarPDF
        Wmap.Range("U11").Value = Sheets("Dados").Cells(i, 1)
        Arq = Format(Range("B16").Value) & "_" & Format(Range("B11").Value)
        Wmap.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=ActiveWorkbook.Path & "" & Arq & ".pdf", _
                                    Quality:=xlQualityMinimum, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
    Next
    
    Unload frmBarraDeProgresso
    
    MsgBox "Cálculos efetuados com sucesso.", vbInformation, "ATENÇÃO"

End Sub

Sim, Edivan. É o que necessito.

jlvfrança

Reinaldo, muito obrigado. Era o que estava precisando.

Abraços