Bom dia robo8268,

Cara, não fiz testes por motivos óbvios, mas tenta assim:

Dim PosErroProximo  As Long

Sub Graficos()
Dim itens(1 To 6, 1 To 2) As Variant
Dim pt As PivotTable
Dim grafico As Object
Dim inicioIntervalo As Integer, finalIntervalo As Integer, apontamentoAtual As Integer, pilarAtual As Integer
Dim erro As Integer

apontamentoAtual = Sheets("Início").Range("L3").Value
pilarAtual = Sheets("Início").Range("L8").Value

Set grafico = Sheets("Início").ChartObjects("chtRanking")
Set pt = Sheets("Ranking").PivotTables("Ranking")

itens(1, 1) = "Eu Acolho"
itens(1, 2) = "Resolutividade"
itens(2, 1) = "Eu Soluciono"
itens(2, 2) = "Resolutividade"
itens(3, 1) = "Eu Transmito Segurança"
itens(3, 2) = "Resolutividade"
itens(4, 1) = "Eu Acolho"
itens(4, 2) = "Aderência"
itens(5, 1) = "Eu Soluciono"
itens(5, 2) = "Aderência"
itens(6, 1) = "Eu Transmito Segurança"
itens(6, 2) = "Aderência"

Dim teste As String

For i = 1 To 2

Sheets("Início").Range("L3").Value = i

With pt.PivotFields("Pilar")
   .ClearAllFilters
End With
With pt.PivotFields("Apontamento")
   .ClearAllFilters
End With

    For j = 1 To 3
    erro = 0
      Sheets("Início").Range("L8").Value = j
        With pt.PivotFields("Apontamento")
           .ClearAllFilters
           On Error GoTo ErroApontamento
'----------------> linha onde o erro ocorre
            Call gerar
            If PosErroProximo >= 0 Then GoTo ProximaIteracao
           '.CurrentPage = Sheets("Início").Range("L4").Value
           On Error GoTo 0
        End With
        If erro < 1 Then
        With pt.PivotFields("Pilar")
           .ClearAllFilters
           On Error GoTo Mensagem
           .CurrentPage = Sheets("Início").Range("L10").Value
           On Error GoTo 0
        End With
        Else: GoTo ProximaIteracao

    Call SalvarGrafico
        End If
    inicioIntervalo = Sheets("Ranking").Range("inicioIntervalo").Value
    
    finalIntervalo = Sheets("Ranking").Range("finalIntervalo").Value
    
    grafico.Activate
    If finalIntervalo > 5 Then
        ActiveChart.FullSeriesCollection(1).Values = Sheets("Ranking").Range("B5:B" & finalIntervalo)
        ActiveChart.FullSeriesCollection(1).XValues = Sheets("Ranking").Range("A5:A" & finalIntervalo)
    Else
        ActiveChart.FullSeriesCollection(1).Values = Sheets("Ranking").Range("B5")
        ActiveChart.FullSeriesCollection(1).XValues = Sheets("Ranking").Range("A5")
    End If
    Call SalvarGrafico
    Next j
'----------->após a execução do tratamento de erro, ele direciona pra cá...
ProximaIteracao:
PosErroProximo = 0
On Error GoTo 0
Next i
Sheets("Início").Range("L3") = apontamentoAtual
Sheets("Início").Range("L8") = pilarAtual
erro = 0
With pt.PivotFields("Apontamento")
   .ClearAllFilters
  On Error GoTo Mensagem
.CurrentPage = Sheets("Início").Range("L4").Value

End With
erro = 0
With pt.PivotFields("Pilar")
   .ClearAllFilters
   On Error GoTo Mensagem
   .CurrentPage = Sheets("Início").Range("L10").Value
End With
    inicioIntervalo = Sheets("Ranking").Range("inicioIntervalo").Value
    
    finalIntervalo = Sheets("Ranking").Range("finalIntervalo").Value
    
    grafico.Activate
    If finalIntervalo > 5 Then
        ActiveChart.FullSeriesCollection(1).Values = Sheets("Ranking").Range("B5:B" & finalIntervalo)
        ActiveChart.FullSeriesCollection(1).XValues = Sheets("Ranking").Range("A5:A" & finalIntervalo)
    Else
        ActiveChart.FullSeriesCollection(1).Values = Sheets("Ranking").Range("B5")
        ActiveChart.FullSeriesCollection(1).XValues = Sheets("Ranking").Range("A5")
    End If
Call EnviarEmail
Exit Sub


Mensagem:
grafico.Activate
If erro = 0 Then
erro = 1
Else: erro = 2
End If
With ActiveChart.FullSeriesCollection(1)
    .Values = Sheets("Ranking").Range("G1")
    .XValues = Sheets("Ranking").Range("F1")
End With
If erro = 1 Then
Resume Next
Else: GoTo ProximaIteracao
End If
End Sub

Private Sub Gera()
Dim pt  As PivotTable
On Error GoTo ErroApontamento

    Set pt = Sheets("Ranking").PivotTables("Ranking")
    
    With pt.PivotFields("Apontamento").CurrentPage = Sheets("Início").Range("L4").Value
    
ErroApontamento:

    For k = 1 To 3
        Sheets("Início").Range("L8").Value = k
        grafico.Activate
        
        With ActiveChart.FullSeriesCollection(1)
            .Values = Sheets("Ranking").Range("G1")
            .XValues = Sheets("Ranking").Range("F1")
        End With
        
        Call SalvarGrafico
    Next k
    
    PosErroProximo = 1

End Sub

Qualquer coisa da o grito.
Abraço

Bernardo muito obrigado, adaptei o seu código e fiz algumas alterações e funcionou... valeu