Barra de Progresso na StatusBar do Excel

Ola a todos!

Pessoal é o seguinte, tenho um código que segue abaixo que faz uma serie de formatação à um arquivo .txt que segue em anexo. O código funciona perfeitamente, porem ñ consigo colocar uma Barra de Progresso na StatusBar! o código contem muitos loops, já fiz de tudo! e ñ sei como encaixar uma barra de progresso nele.

Recorri a vocês porque com certeza a lógica de como colocar Barra de Progresso na StatusBar! do excel com certeza se aplica no Access.

Peço ajuda nisso, por favor!


- Em anexo está o .txt que a macro vai pedir
- O código pode ser executado em qualquer aquivo do excel que contenha apenas a Plan1, Plan2 e Plan3

Segue código:

Código:

Sub Gera_NivelNivel_e_Analise()

'Desenvolvimento André E. Simões
'-------------------------------DEFINIÇÃO DA FUNÇÃO------------------------------------------'
' Gera Nivel à Nivel na Planilha CONSULTA ANÁLISE com base no aquivo gerado pelo EMS (ES0506)'
' e colocar os níves 03 na Planilha ANÁLISE.                                                 '
'--------------------------------------------------------------------------------------------'

Volta:
Semana = InputBox(Prompt:="FAVOR INFORMAR A SEMANA...", Title:="SEMANA", Default:="")

If Semana = "" Then
   Exit Sub
End If

Confirma = MsgBox(Prompt:="Você confirma a nova Análise como:" + vbCrLf + "" + vbCrLf + " ANÁLISE SEM." & Semana, Title:="Confirma Analise", Buttons:=vbOKCancel + vbQuestion)

If Confirma = vbCancel Then
   GoTo Volta
End If

Dim datainicio As Date
Dim datafim As Date
Dim resultadotempo As Date
Dim Arquivo As String

Arquivo = Application.GetOpenFilename("Arquivos Texto(*.txt; *.tmp), *.txt", , "Selecione o arquivo de texto gerado pela tela ES0506")

If Arquivo <> "Falso" Then
      
   Gerador = MsgBox(Prompt:="Gerando Análise: " & "SEM." & Semana + vbCrLf + "" + vbCrLf + "Para cancelar aperte CTRL + BREAK e aperte o Botão Fim", Title:="GERADOR DE ANÁLISE", Buttons:=vbOKCancel + vbInformation)
  
   If Gerador = vbCancel Then
      Workbooks("GERADOR DE ANALISE.xlsm").Close
      Exit Sub
   End If
  
  
   Application.DisplayAlerts = False 'desabilite o alerta
   Application.ScreenUpdating = False 'DEIXA A TELA ESTATICA
      

   Analise = "ANÁLISE SEM." & Semana
  
   Sheets("Plan1").Name = Analise
   Sheets("Plan2").Name = "PLAN 02-PLAN 03"
   Sheets("Plan3").Name = "PLAN 04-PLAN 06"
   Sheets.add After:=Sheets(Sheets.Count)
   ActiveSheet.Name = "PLAN 09"
   Sheets.add After:=Sheets(Sheets.Count)
   ActiveSheet.Name = "CONSULTA ANÁLISE"
  
   Sheets("CONSULTA ANÁLISE").Select
  
   ' ---Formatação---
  
   Open Arquivo For Input As #1
   With ActiveSheet.QueryTables.add(Connection:="TEXT;" & Arquivo, Destination:=Range("a1"))
   Close
           .FieldNames = True
           .RowNumbers = False
           .FillAdjacentFormulas = False
           .PreserveFormatting = True
           .RefreshOnFileOpen = False
           .RefreshStyle = xlInsertDeleteCells
           .SavePassword = False
           .SaveData = True
           .AdjustColumnWidth = True
           .RefreshPeriod = 0
           .TextFilePromptOnRefresh = False
           .TextFilePlatform = 1252
           .TextFileStartRow = 1
           .TextFileParseType = xlFixedWidth
           .TextFileTextQualifier = xlTextQualifierDoubleQuote
           .TextFileConsecutiveDelimiter = False
           .TextFileTabDelimiter = True
           .TextFileSemicolonDelimiter = False
           .TextFileCommaDelimiter = False
           .TextFileSpaceDelimiter = False
           .TextFileColumnDataTypes = Array(2, 2, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1)
           .TextFileFixedColumnWidths = Array(17, 17, 60, 19, 18, 19, 3, 3, 1, 18, 13)
           .TextFileTrailingMinusNumbers = True
           .Refresh BackgroundQuery:=False
       End With
       Rows("1:4").Select
       Range("A4").Activate
       Selection.Delete Shift:=xlUp
       Rows("2:2").Select
       Selection.Delete Shift:=xlUp
       Columns("A:A").Select
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
       Selection.Insert Shift:=xlToRight
      
       Range("A1").Select
       ActiveCell.FormulaR1C1 = "Enc"
       Range("B1").Select
       ActiveCell.FormulaR1C1 = "Cod nivel 2"
       Range("C1").Select
       ActiveCell.FormulaR1C1 = "Descrição Comp. nivel 2"
       Range("D1").Select
       ActiveCell.FormulaR1C1 = "Cod nivel 3"
       Range("E1").Select
       ActiveCell.FormulaR1C1 = "Descrição Comp. nivel 3"
       Range("F1").Select
       ActiveCell.FormulaR1C1 = "Cod nivel 4"
       Range("G1").Select
       ActiveCell.FormulaR1C1 = "Descrição Comp. nivel 4"
       Range("H1").Select
       ActiveCell.FormulaR1C1 = "Cod nivel 5"
       Range("I1").Select
       ActiveCell.FormulaR1C1 = "Descrição Comp. nivel 5"
       Range("J1").Select
       ActiveCell.FormulaR1C1 = "Cod nivel 6"
       Range("K1").Select
       ActiveCell.FormulaR1C1 = "Descrição Comp. nivel 6"
       Range("L1").Select
       ActiveCell.FormulaR1C1 = "Cod nivel 7"
       Range("M1").Select
       ActiveCell.FormulaR1C1 = "Descrição Comp. nivel 7"
       Range("N1").Select
       ActiveCell.FormulaR1C1 = "Cod nivel 8"
       Range("O1").Select
       ActiveCell.FormulaR1C1 = "Descrição Comp. nivel 8"
      
   ' --- Encomenda ---
   ' --- Nivel 1 ---
  
   Range("P2").Select
  
   While ActiveCell <> ""
   Do
      If ActiveCell = "1" Then
         Selection.Offset(0, -15) = Selection.Offset(0, 1)
         Selection.Offset(1, 0).Select
      Else
         Selection.Offset(0, -15) = Selection.Offset(-1, -15)
         Selection.Offset(1, 0).Select
      End If
   Loop Until ActiveCell = ""
   Wend
    
   ' ---Descrição---
   ' --- Nivel 2 ---
  
   Range("P3").Select
  
   While ActiveCell <> ""
   Do
      If ActiveCell = "-2" Then
         Selection.Offset(0, -14) = Selection.Offset(0, 1)
         Selection.Offset(0, -13) = Selection.Offset(0, 2)
         Selection.Offset(1, 0).Select
      Else
         Selection.Offset(0, -13) = Selection.Offset(-1, -13)
         Selection.Offset(0, -14) = Selection.Offset(-1, -14)
         Selection.Offset(1, 0).Select
      End If
   Loop Until ActiveCell = ""
   Wend
  
   ' --- Nivel 3 ---
  
   Range("P3").Select
  
   While ActiveCell <> ""
   Do
      If ActiveCell = "-2" Then
         Selection.Offset(1, 0).Select
      Else
          If ActiveCell = "--3" Then
             Selection.Offset(0, -12) = Selection.Offset(0, 1)
             Selection.Offset(0, -11) = Selection.Offset(0, 2)
             Selection.Offset(1, 0).Select
          Else
             Selection.Offset(0, -11) = Selection.Offset(-1, -11)
             Selection.Offset(0, -12) = Selection.Offset(-1, -12)
             Selection.Offset(1, 0).Select
          End If
      End If
   Loop Until ActiveCell = ""
   Wend
  
   ' --- Nivel 4 ---
  
   Range("P3").Select
  
   While ActiveCell <> ""
   Do
      If ActiveCell = "-2" Then
         Selection.Offset(1, 0).Select
      Else
          If ActiveCell = "--3" Then
             Selection.Offset(1, 0).Select
          Else
              If ActiveCell = "---4" Then
                 Selection.Offset(0, -10) = Selection.Offset(0, 1)
                 Selection.Offset(0, -9) = Selection.Offset(0, 2)
                 Selection.Offset(1, 0).Select
              Else
                 Selection.Offset(0, -9) = Selection.Offset(-1, -9)
                 Selection.Offset(0, -10) = Selection.Offset(-1, -10)
                 Selection.Offset(1, 0).Select
              End If
          End If
      End If
   Loop Until ActiveCell = ""
   Wend
  
   ' --- Nivel 5 ---
  
   Range("P3").Select
  
   While ActiveCell <> ""
   Do
      If ActiveCell = "-2" Then
         Selection.Offset(1, 0).Select
      Else
          If ActiveCell = "--3" Then
             Selection.Offset(1, 0).Select
          Else
              If ActiveCell = "---4" Then
                 Selection.Offset(1, 0).Select
              Else
                 If ActiveCell = "----5" Then
                    Selection.Offset(0, -8) = Selection.Offset(0, 1)
                    Selection.Offset(0, -7) = Selection.Offset(0, 2)
                    Selection.Offset(1, 0).Select
                 Else
                    Selection.Offset(0, -7) = Selection.Offset(-1, -7)
                    Selection.Offset(0, -8) = Selection.Offset(-1, -8)
                    Selection.Offset(1, 0).Select
                 End If
              End If
          End If
      End If
   Loop Until ActiveCell = ""
   Wend
  
   ' --- Nivel 6 ---
  
   Range("P3").Select
  
   While ActiveCell <> ""
   Do
      If ActiveCell = "-2" Then
         Selection.Offset(1, 0).Select
      Else
          If ActiveCell = "--3" Then
             Selection.Offset(1, 0).Select
          Else
              If ActiveCell = "---4" Then
                 Selection.Offset(1, 0).Select
              Else
                  If ActiveCell = "----5" Then
                     Selection.Offset(1, 0).Select
                  Else
                     If ActiveCell = "-----6" Then
                        Selection.Offset(0, -6) = Selection.Offset(0, 1)
                        Selection.Offset(0, -5) = Selection.Offset(0, 2)
                        Selection.Offset(1, 0).Select
                     Else
                        Selection.Offset(0, -5) = Selection.Offset(-1, -5)
                        Selection.Offset(0, -6) = Selection.Offset(-1, -6)
                        Selection.Offset(1, 0).Select
                     End If
                 End If
              End If
          End If
      End If
   Loop Until ActiveCell = ""
   Wend
  
   ' --- Nivel 7 ---
  
   Range("P3").Select
  
   While ActiveCell <> ""
   Do
      If ActiveCell = "-2" Then
         Selection.Offset(1, 0).Select
      Else
          If ActiveCell = "--3" Then
             Selection.Offset(1, 0).Select
          Else
              If ActiveCell = "---4" Then
                 Selection.Offset(1, 0).Select
              Else
                  If ActiveCell = "----5" Then
                     Selection.Offset(1, 0).Select
                  Else
                     If ActiveCell = "-----6" Then
                        Selection.Offset(1, 0).Select
                     Else
                        If ActiveCell = "------7" Then
                           Selection.Offset(0, -4) = Selection.Offset(0, 1)
                           Selection.Offset(0, -3) = Selection.Offset(0, 2)
                           Selection.Offset(1, 0).Select
                        Else
                           Selection.Offset(0, -3) = Selection.Offset(-1, -3)
                           Selection.Offset(0, -4) = Selection.Offset(-1, -4)
                           Selection.Offset(1, 0).Select
                        End If
                     End If
                 End If
              End If
          End If
      End If
   Loop Until ActiveCell = ""
   Wend
  
   ' --- Nivel 8 ---
  
   Range("P3").Select
  
   While ActiveCell <> ""
   Do
      If ActiveCell = "-2" Then
         Selection.Offset(1, 0).Select
      Else
          If ActiveCell = "--3" Then
             Selection.Offset(1, 0).Select
          Else
              If ActiveCell = "---4" Then
                 Selection.Offset(1, 0).Select
              Else
                  If ActiveCell = "----5" Then
                     Selection.Offset(1, 0).Select
                  Else
                     If ActiveCell = "-----6" Then
                        Selection.Offset(1, 0).Select
                     Else
                        If ActiveCell = "------7" Then
                           Selection.Offset(1, 0).Select
                        Else
                           If ActiveCell = "-------8" Then
                              Selection.Offset(0, -2) = Selection.Offset(0, 1)
                              Selection.Offset(0, -1) = Selection.Offset(0, 2)
                              Selection.Offset(1, 0).Select
                           Else
                              Selection.Offset(0, -1) = Selection.Offset(-1, -1)
                              Selection.Offset(0, -2) = Selection.Offset(-1, -2)
                              Selection.Offset(1, 0).Select
                           End If
                        End If
                     End If
                 End If
              End If
          End If
      End If
   Loop Until ActiveCell = ""
   Wend
  
   '-----FORMATAÇÃO APOS CONCLUIR-----
  
   '------Exclui colunas-------
   Columns("S:T").Select 'Quantidade Usada e Saldo Estoque
   Selection.Delete Shift:=xlToLeft
      
   Columns("V:X").Select ' T, Desenho, comprador
   Selection.Delete Shift:=xlToLeft
  
   '----Insere novas colunas----
   Columns("B:B").Select
   Selection.Insert Shift:=xlToRight
   Selection.Insert Shift:=xlToRight
   Selection.Insert Shift:=xlToRight
      
   '----Move colunas----
   Columns("T:V").Select
   Selection.Cut Destination:=Columns("B:D")
      
   '------Exclui colunas movidas-------
   Selection.Delete Shift:=xlToLeft
        
   '----Altera desc colula D1----
   Range("D1").Select
   ActiveCell.FormulaR1C1 = "Qtde"
  
   '----Altera desc colula W1----
   Range("W1").Select
   ActiveCell.FormulaR1C1 = "Comp. Direto De"
   Range("X1").Select
   ActiveCell.FormulaR1C1 = "Descrição Comp. Direto De"
      
   '----ACERTA PARA PROCV COMP.----
  
   Range("B2").Select
  
   While ActiveCell <> ""
   Do
  
   If Selection.Offset(0, 21) = "" Then
  
      If Selection.Offset(0, 15) <> "" And Selection.Offset(0, 15) <> ActiveCell Then
         Selection.Offset(0, 21) = Selection.Offset(0, 15)
         Selection.Offset(0, 22) = Selection.Offset(0, 16)
      Else
         If Selection.Offset(0, 13) <> "" And Selection.Offset(0, 13) <> ActiveCell Then
            Selection.Offset(0, 21) = Selection.Offset(0, 13)
            Selection.Offset(0, 22) = Selection.Offset(0, 14)
         Else
            If Selection.Offset(0, 11) <> "" And Selection.Offset(0, 11) <> ActiveCell Then
               Selection.Offset(0, 21) = Selection.Offset(0, 11)
               Selection.Offset(0, 22) = Selection.Offset(0, 12)
            Else
               If Selection.Offset(0, 9) <> "" And Selection.Offset(0, 9) <> ActiveCell Then
                  Selection.Offset(0, 21) = Selection.Offset(0, 9)
                  Selection.Offset(0, 22) = Selection.Offset(0, 10)
               Else
                  If Selection.Offset(0, 7) <> "" And Selection.Offset(0, 7) <> ActiveCell Then
                     Selection.Offset(0, 21) = Selection.Offset(0, 7)
                     Selection.Offset(0, 22) = Selection.Offset(0,
                  Else
                     If Selection.Offset(0, 5) <> "" And Selection.Offset(0, 5) <> ActiveCell Then
                        Selection.Offset(0, 21) = Selection.Offset(0, 5)
                        Selection.Offset(0, 22) = Selection.Offset(0, 6)
                     Else
                        If Selection.Offset(0, 3) <> "" And Selection.Offset(0, 3) <> ActiveCell Then
                           Selection.Offset(0, 21) = Selection.Offset(0, 3)
                           Selection.Offset(0, 22) = Selection.Offset(0, 4)
                        Else
                           Selection.Offset(1, 0).Select
      End If
           End If
                End If
                      End If
                          End If
                              End If
                                  End If
          
   Else
      Selection.Offset(1, 0).Select
   End If
  
   Loop Until ActiveCell = ""
   Wend
  
   '------Pinta Fundo cabeçalho-------
   Range("A1:X1").Select
   With Selection.Interior
       .PatternColorIndex = xlAutomatic
       .ThemeColor = xlThemeColorLight1
       .TintAndShade = 0
       .PatternTintAndShade = 0
   End With
      
   '------Pinta Fonte cabeçalho------
       With Selection.Font
           .ThemeColor = xlThemeColorDark1
           .TintAndShade = 0
       End With
       Selection.Font.Bold = True
  
   '----Coloca filtro----
   Selection.AutoFilter
   '----Acerta espaçamento colulas----
   ActiveWindow.Zoom = 85
   Cells.Select
   Cells.EntireColumn.AutoFit
   Range("A1").Select
 
Else
MsgBox "Nenhum arquivo foi selecionado."
Workbooks("GERADOR DE ANALISE.xlsm").Close
Exit Sub
End If

'-------------------------------DEFINIÇÃO DA FUNÇÃO-----------------------------------'
' Exportar nivel 03 da planilha CONSULTA ANÁLISE para a PLANILHA ANÁLISE.             '
'-------------------------------------------------------------------------------------'
Dim add As Integer
Dim add1 As Integer

Sheets(Analise).Select

'-------FORMATA ABA ANALISE--------
    Range("A1") = Analise
  
    Range("A1:H2").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Bold = True

    Range("A1:H2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
      
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Componente"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "Descrição"
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "F"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "Plan 02/Plan 03"
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "Plan 04/Plan 06"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "Plan 09"
    Range("G3").Select
    ActiveCell.FormulaR1C1 = "U.P.S."
    Range("H3").Select
    ActiveCell.FormulaR1C1 = "Divergências"
    Range("A3:H3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A3:R3").Select
    Selection.AutoFilter
    Range("A4").Select

'-------FINALIZA FORMATAÇÃO ABA ANALISE--------

Sheets("CONSULTA ANÁLISE").Select
    
Do While Not ActiveSheet.Cells(2 + add, 2) = ""
   If ActiveSheet.Cells(2 + add, 19) = "--3" Then
      Range("B" & 2 + add, "C" & 2 + add).Copy
      Sheets(Analise).Select
      ActiveSheet.Cells(4 + add1, 1).Select
      ActiveSheet.Paste
      Sheets("CONSULTA ANÁLISE").Select
      Range("U" & 2 + add).Copy
      Sheets(Analise).Select
      ActiveSheet.Cells(4 + add1, 3).Select
      ActiveSheet.Paste
      add1 = add1 + 1
      add = add + 1
   Else
       add = add + 1
   End If
Sheets("CONSULTA ANÁLISE").Select
Loop
   Sheets(Analise).Select
   Columns("A:G").Select
   ActiveSheet.Range("$A$4:$G$90000").RemoveDuplicates Columns:=1, Header:=xlYes
    
   Sheets(Analise).Select
   Columns("A:H").Select
   Columns("A:H").EntireColumn.AutoFit
   Range("A4").Select
   ActiveWindow.Zoom = 85
 
'---------Formata Planilha PLAN 02-PLAN 03---------------

    Sheets("PLAN 02-PLAN 03").Select
    Range("A1") = Analise
    Range("A1:R3").Select
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Range("A1:R2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("A1:R3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Enc"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "Plan Sistema"
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "Situação"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "Plan"
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "Setor"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "Sigla"
    Range("G3").Select
    ActiveCell.FormulaR1C1 = "Observação"
    Range("H3").Select
    ActiveCell.FormulaR1C1 = "O/S"
    Range("I3").Select
    ActiveCell.FormulaR1C1 = "Componente"
    Range("J3").Select
    ActiveCell.FormulaR1C1 = "Descrição Componente"
    Range("K3").Select
    ActiveCell.FormulaR1C1 = "Qtde"
    Range("L3").Select
    ActiveCell.FormulaR1C1 = "Stq"
    Range("M3").Select
    ActiveCell.FormulaR1C1 = "Saldo Dis 07"
    Range("N3").Select
    ActiveCell.FormulaR1C1 = "Saldo Dis 07B"
    Range("O3").Select
    ActiveCell.FormulaR1C1 = "100"
    Range("P3").Select
    ActiveCell.FormulaR1C1 = "Nível"
    Range("Q3").Select
    ActiveCell.FormulaR1C1 = "Und"
    Range("R3").Select
    ActiveCell.FormulaR1C1 = "F"
    Range("A3:R3").Select
    Selection.AutoFilter
    ActiveWindow.Zoom = 85

'----------Finaliza Formatação Planilha PLAN 02-PLAN 03--------------

'----------Coloca informação da planilha CONSULTA ANALISE na Planilha PLAN 02-PLAN 03--------------

   Sheets("CONSULTA ANÁLISE").Select
   Range("A2:A1048510").Select
   Selection.Copy
   Sheets("PLAN 02-PLAN 03").Select
   Range("A4").Select
   ActiveSheet.Paste
    
   Sheets("CONSULTA ANÁLISE").Select
   Range("V2:V1048510").Select
   Selection.Copy
   Sheets("PLAN 02-PLAN 03").Select
   Range("B4").Select
   ActiveSheet.Paste
    
   Sheets("CONSULTA ANÁLISE").Select
   Range("B2:D1048510").Select
   Selection.Copy
   Sheets("PLAN 02-PLAN 03").Select
   Range("I4").Select
   ActiveSheet.Paste
  
   Sheets("CONSULTA ANÁLISE").Select
   Range("S2:U1048510").Select
   Selection.Copy
   Sheets("PLAN 02-PLAN 03").Select
   Range("P4").Select
   ActiveSheet.Paste
    
'----------Finaliza Coloca informação da planilha CONSULTA ANALISE na Planilha PLAN 02-PLAN 03--------------

'----------Retira Itens desnecessarios da planilha PLAN 02-PLAN 03--------------
  
    Range("A4").Select
    ActiveSheet.Range("$A$3:$R$1048576").AutoFilter Field:=16, Criteria1:="=1", Operator:=xlOr, Criteria2:="=-2"
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Rows(ActiveCell.Row).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$3:$R$1048576").AutoFilter Field:=16
    
    Range("A4").Select
    ActiveSheet.Range("$A$3:$R$1048576").AutoFilter Field:=9, Criteria1:="=9*", Operator:=xlAnd
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Rows(ActiveCell.Row).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$3:$R$1048576").AutoFilter Field:=9

    Range("A4").Select
    ActiveSheet.Range("$A$3:$R$1048576").AutoFilter Field:=9, Criteria1:="=F*", Operator:=xlAnd
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Rows(ActiveCell.Row).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$3:$R$1048576").AutoFilter Field:=9
    
    Range("A4").Select
    ActiveSheet.Range("$A$3:$R$1048576").AutoFilter Field:=9, Criteria1:="=C*", Operator:=xlAnd
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Rows(ActiveCell.Row).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$3:$R$1048576").AutoFilter Field:=9
    ActiveWindow.Zoom = 85
    Cells.Select
    Cells.EntireColumn.AutoFit

'----------Finaliza Retira Itens desnecessarios da planilha PLAN 02-PLAN 03--------------

'----------Copia informações da planilha PLAN 02-PLAN 03 e cola na planilha PLAN 04-PLAN 06 E PLAN 09--------------

    Cells.Select
    Selection.Copy
    Sheets("PLAN 04-PLAN 06").Select
    Range("A1").Select
    ActiveSheet.Paste
    ActiveWindow.Zoom = 85
    Range("A3:R3").Select
    Selection.AutoFilter
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A4").Select
    
    Sheets("PLAN 02-PLAN 03").Select
    Cells.Select
    Selection.Copy
    Sheets("PLAN 09").Select
    Range("A1").Select
    ActiveSheet.Paste
    ActiveWindow.Zoom = 85
    Range("A3:R3").Select
    Selection.AutoFilter
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A4").Select
    
'----------Finalisa Copia informações da planilha PLAN 02-PLAN 03 e cola na planilha PLAN 04-PLAN 06 E PLAN 09--------------

Sheets("PLAN 02-PLAN 03").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("PLAN 04-PLAN 06").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("PLAN 09").Select
ActiveWindow.SelectedSheets.Visible = False

Workbooks("GERADOR DE ANALISE.xlsm").Close

Application.ScreenUpdating = True 'RETIRA A TELA ESTATICA
Application.DisplayAlerts = True 'habilite novamente o alerta

End Sub

Segue agora o código da Barra de Progresso na StatusBar que ñ consigo encaixar

Código:

Sub BarraDeProgresso()
Dim i               As Long
Dim iUltimaLinha    As Long
Dim sStatusProcesso As String
 
    iUltimaLinha = ActiveSheet.Range("A1").End(xlDown).Row
 
    sStatusProcesso = "Aguarde... O sistema está processando as informações. "
 
    Application.StatusBar = sStatusProcesso
 
    For i = 2 To iUltimaLinha
        Application.StatusBar = sStatusProcesso & Format(i / iUltimaLinha, "0.0%") & " Concluído"
        ' O código vai aqui...
        
    Next
 
    Application.StatusBar = False
 
    MsgBox "Processo concluído.", vbInformation, "Excel do Seu Jeito"
 
End Sub

Boa tarde,
Movi o tema para esta sala. O fórum está vocacionado para o Access