Boa noite!!

Eu não entendi muito bem...
Seria..altere

U = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row ' ultima linha

Para.......

U = ActiveSheet.Cells(Cells.Rows.Count, 4).End(xlUp).Row ' ultima linha

Boa noite Alexandre

Desculpe Se não fui claro. O que eu quero saber é o seguinte:

A minha macro não está indo até a ultima linha, Será por causa desta linha do código Que inseri linhas ?

Range("D" & r).EntireRow.Insert
          r = r + 1

Se for este o caso eu tenho que Atualizar a variavel U sempre que eu inserir novas linhas ?
Exemplo:

Range("D" & r).EntireRow.Insert
          r = r + 1
          u = u + 1

Se tiver é só escrever como o exemplo ?

Att.

Boa noite!!

Eu acho melhor deixar as feras de VBA responder

Sub Concilar()
Dim U As Long
 U = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
For r = U To 3 Step -1
    If Range("E" & r).Value = "" Then
    Range("C" & r).FormulaR1C1 = "=OBTERNF(RC[1])"
    Else: Range("D" & r).Value = Range("E" & r).Value
          Range("D" & r).EntireRow.Insert
          r = r + 1
            With ActiveSheet.Rows(r & ":" & r).Font
            .Bold = True
            .Italic = True
            .Size = 10
            .Name = "Times New Roman"
            .ColorIndex = 3
        End With
    End If
Next r
End Sub

Boa noite galera,

Não sei se entendi muito bem, acho que é isso mesmo... como tem uma rotina que inclui mais uma linha, a variável U continua com o mesmo valor, fazendo com que não chegue até o final atual. Tenta essa:

Sub Concilar()
Dim U As Long
Dim r As Long
U = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row ' ultima linha
For r = 1 To U
    If Range("E" & r).Value = "" Then
    Range("C" & r).FormulaR1C1 = "=OBTERNF(RC[1])"
    Else: Range("D" & r).Value = Range("E" & r).Value
          Range("D" & r).EntireRow.Insert
          r = r + 1
          U = U + 1
            With ActiveSheet.Rows(r & ":" & r).Font
            .Bold = True
            .Italic = True
            .Size = 10
            .Name = "Times New Roman"
            .ColorIndex = 3
        End With
    End If
Next r
End Sub

Qualquer coisa da o grito.
Abraço

Se não for isso posta uma planilha com poucas informações com exemplo.

Guma, o ideal é fazer como o Bernardo disse e anexar um exemplo compactado para ter uma analise melhor da situação, as instruções que o Alexandre e o Bernardo postaram a um primeiro olhar parece que resolveria, mas acredito que não irá, e o motivo é a incrementação das variaveis, explicando :

Aqui captamos a ultima celula
U = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row ' ultima linha

Aqui adicionamos o For, que está armazendando as variaveis e fazendo a contagem
For r = 1 To U

então quando incrementamos a variável "r" com + 1, independente da qde de linhas o valor de "r" chegara ao valor final antes de terminar a contagem de "U"

Supondo que tenhamos 3 linhas, ficaria :
For 1 to 3 - ao incrementarmos a variavel "r" a mesma passaria para "2 TO 4" ou seja nesta linha alteramos o valor da variavel para 2 mas qdo chegar em Next r ele assumirá o valor de 3 e na sequencia ficaria 4 to 4 e sairia da rotina por ter alcançado o valor incrementado antes de chegar ao final de total de linhas.

Espero que tenha conseguido explicar, é mais fácil falar do que escrever, rsrsrsr, mas é só seguir passo a passo a rotina utilizando a tecla F8 e entenderá melhor, por isso que o ideal é um exemplo, pois na rotina se em E1 for Vazio vai adicionar uma formula que acredito ser um UDF e vai dar confusão na rotina.

[]s

É Realmente não funcionou como o Mauro disse.
e Fernando eu preciso atualizar a Variável r eu tentei fazer sem isso mas ele bagunçou minha estrutura, como devo fazer então ?

Vou tentar postar um exemplo da minha Planilha. Como a planilha original contem informações de um Cliente não posso postar aqui, vou ver se consigo criar uma com informações fictícias, mas como ela é um pouco chata só vou conseguir fazer na hora do almoço.

att.

Apaguei minha resposta pois analisei melhor o problema e vi que eu tinha falado besteira.

O problema do seu código é mais embaixo.

Você usou um For/Next, mas este não te atenderá direito, pois ele trabalha com intervalo final fixo (no seu caso a variável U).
Mas no meio do seu For/Next, você está inserindo uma linha, e obviamente o U deveria mudar, mas o For/Next não permite isso.
Você poderia usar um Do/While While/Wend, escolha outro loop onde todas as variáveis podem ser alteradas dirante a execução.

Assim:

sub Concilar
Dim U As Long
dim r as long
  U = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row ' ultima linha
  r=1
  Do While r<=u 'faça tudo que existe abaixo, enquanto r for menor ou igual a u. assim as duas variáveis vão aumentar, até r encontrar u.
    If Range("E" & r).Value = "" Then
      Range("C" & r).FormulaR1C1 = "=OBTERNF(RC[1])" 'se não houver valor na coluna E da linha r, colocar fórmula na coluna C da linha r
    Else
      Range("D" & r).Value = Range("E" & r).Value
      Range("D" & r).EntireRow.Insert 'inseriu a linha, ou seja, empurrou a linha r para baixo.
      r=r+1 'definiu r como r+1, pois é para formatar a linha foi movida para baixo, 
      u=u+1 'ja que inseriu linha, U tem q ser somado de 1, pois é a nova ultima linha
      With ActiveSheet.Rows(r & ":" & r).Font 'aplica esta formatação na linha inserida, que é o novo r
        .Bold = True
        .Italic = True
        .Size = 10
        .Name = "Times New Roman"
        .ColorIndex = 3
      End With
    End If
  loop

end sub

Faça isso e aplique no seu primeiro modelo de código, o da sua pergunta.

F.F.

Colegas como eu citei acima, o ideal é um exemplo simplificado com o layout que ele está utilizando, pois tanto o uso do For ... Next ou Do While ... Loop ... Wend, precisamos tomar cuidado para não entrarmos em um Loop infinito.

Fernando, na rotina que postou acontece este loop pois estamos incrementando as duas Variáveis e na condição :
Do While r <= U - r sempre será menor que U, e mais abaixo ainda temos :
If Range("E" & r).Value = "" Then - que dependendo do valor em "E" & "r" a rotina se comportara de maneiras diferentes, ou seja se estiver vazia ou se contiver um valor vamos para caminhos diferentes, ou seja se for vazia o loop infinito sem realizar a ações esperadas e se tiver algum valor acrescentara somente linhas acima e tb em loop infinito.

[]s

Mauro, tens razão.
Na empolgação da troca do For/Next pelo Do/While/Loop, eu esqueci de incrementar o r, o que já ocorria automaticamente no For/Next, e neste caso tem necessariamente que acontecer em todas iterações do loop, independente da condição.

sub Concilar
Dim U As Long
dim r as long
  U = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row ' ultima linha
  r=1
  Do While r<=u 'faça tudo que existe abaixo, enquanto r for menor ou igual a u. assim as duas variáveis vão aumentar, até r encontrar u.
    If Range("E" & r).Value = "" Then
      Range("C" & r).FormulaR1C1 = "=OBTERNF(RC[1])" 'se não houver valor na coluna E da linha r, colocar fórmula na coluna C da linha r
    Else
      Range("D" & r).Value = Range("E" & r).Value
      Range("D" & r).EntireRow.Insert 'inseriu a linha, ou seja, empurrou a linha r para baixo.
      r=r+1 'definiu r como r+1, pois é para formatar a linha foi movida para baixo, 
      u=u+1 'ja que inseriu linha, U tem q ser somado de 1, pois é a nova ultima linha
      With ActiveSheet.Rows(r & ":" & r).Font 'aplica esta formatação na linha inserida, que é o novo r
        .Bold = True
        .Italic = True
        .Size = 10
        .Name = "Times New Roman"
        .ColorIndex = 3
      End With
    End If
    r=r+1
  loop

end sub

Se entendi bem essa última do Fernando funcionou...

Boa Tarde

Realmente Bernardo, a ultima Solução postada pelo Fernando resolveu perfeitamente o meu problema.
Em todo Caso estou postando meu layout simplificado com o código completo já com a segunda atualização proposta por ele.

Obs: Como o Fernando havia mencionado na primeira postagem meu código é um pouco lento, porque como estou começando agora a aprender VBA, comecei gravando uma Macro
Com o gravador e fui Limpado o Código até chegar neste resultado. Se Alguém puder dar umas dicas de como simplificar o Código seria de grande ajuda.

Obrigado a Todos.

Att.

Somente endentei o código e organizei, pequenas mudanças apenas, mas vê se ajuda:

Sub Conciliar()
Dim Celula      As Range
Dim U           As Long
Dim R           As Long

Application.Calculation = xlManual
Application.ScreenUpdating = False

R = 2
U = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row    ' ultima linha

Cells.MergeCells = False                                    'Desmescla Todas as Células
Range("B:B,D:J,L:P,R:U ,W:W ,Y:Z").EntireColumn.Delete      'Excluir colunas Que não serã utilizadas
Rows("1:7").Delete                                          'Exclui as 7 primeiras linhas
Columns("C:C").Insert                                       'Insere coluna C

    Do While R <= U                                         'faça tudo que existe abaixo, enquanto r for menor ou igual a u. assim as duas variáveis vão aumentar, até r encontrar u.
        If Range("E" & R).Value = "" Then
            Range("C" & R).FormulaR1C1 = "=OBTERNF(RC[1])"  'se não houver valor na coluna E da linha r, colocar fórmula na coluna C da linha r
        Else
            Range("D" & R).Value = Range("E" & R).Value
            Range("D" & R).EntireRow.Insert                 'inseriu a linha, ou seja, empurrou a linha r para baixo.
            R = R + 1                                       'definiu r como r+1, pois é para formatar a linha foi movida para baixo,
            U = U + 1                                       'ja que inseriu linha, U tem q ser somado de 1, pois é a nova ultima linha
            With ActiveSheet.Rows(R & ":" & R).Font         'aplica esta formatação na linha inserida, que é o novo r
              .Bold = True
              .Italic = True
              .Size = 10
              .Name = "Times New Roman"
              .ColorIndex = 3
            End With
        End If
        R = R + 1
    Loop

 Columns("E:E").Delete
 Call PreecherFornecedor
 
Columns("B:C").NumberFormat = "0"
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveSheet.UsedRange.EntireRow.AutoFit
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

Columns("B:I").ColumnWidth = 100
Columns("B:I").EntireColumn.AutoFit
Rows("1:105").EntireRow.AutoFit
  
End Sub

Function OBTERNF(s As String) As Long
Dim lChar       As Long
Dim sChar       As String
Dim sTemp       As String
    
    For lChar = 1 To Len(s)
        sChar = Mid(s, lChar, 1)
        Select Case sChar
            Case "0" To "9"
                sTemp = sTemp & sChar
            Case Else
                If Len(sTemp) > 0 Then Exit For
        End Select
    Next lChar
    
    If Len(sTemp) > 0 Then
        OBTERNF = CLng(sTemp)
    End If
                
End Function

Sub PreecherFornecedor()
Dim Coluna      As Long
Dim Linha       As Long
Dim Conteudo    As String
Dim LinhaFinal  As Long

Coluna = 2
Linha = 3
LinhaFinal = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
Conteudo = ""

    For x = 1 To LinhaFinal
        If (Cells(Linha, Coluna) <> "") Then
            Conteudo = Cells(Linha, Coluna)
            ElseIf Conteudo <> "" Then
                Cells(Linha, Coluna) = Conteudo
        End If
        Linha = Linha + 1
    Next x

End Sub

Qualquer coisa da o grito.
Abraço

Quem diria, o Bernardo se rendendo ao VBA, rsrsrsrsrsrsr

Seja bem vindo ao Forum sobre VBA, é sempre bom ter mais colaboradores.

[]s