http://www.planilhando.com.br/forum/viewtopic.php?f=10&t=28247&p=140963&hilit=remover#p140963

@karc28

Perfeito, esse link resolveu o segundo loop, o de apagar as linhas onde não tiver valor algum no campo de descrição....

Mas o primeiro loop, você conseguiria me ajudar ? A ideia é como expliquei anteriormente, caso o valor termine com a letra D, vai pegar a descrição da linha debaixo, dar um "ctrl x" e "colar" na linha de descrição onde ta esse valor com a letra D... O resultado de como ficaria está no meu anexo na planilha2...

Consegue me ajudar nesse ?

Obrigado pela resposta cara!

Option Explicit

Sub recortarcolar()
    
    
    Dim DLin As Long
    
    
    Dim linha As Long
    

DLin = Planilha1.UsedRange.Rows.Count
    For linha = 1 To DLin
        
        If Right(Planilha1.Range("E" & linha).Value, 1) = "D" Then
            Planilha1.Range("B" & linha).Value = Planilha1.Range("B" & linha + 1).Value
            Planilha1.Range("B" & linha + 1).EntireRow.Delete
           
            
        End If
        
        
    Next linha
inicio2:
    DLin = Planilha1.UsedRange.Rows.Count
    For linha = 1 To DLin
        
        If Planilha1.Range("B" & linha).Value = "" Then
            
            Planilha1.Range("B" & linha).EntireRow.Delete
            GoTo inicio2
            
        End If
        
        
    Next linha
    
    
End Sub

cara vc é demais!

Eu tinha postado essa dúvida em outro fórum também e obtive o seguinte código, é bem parecido com sua lógica...

Option Explicit

Option Base 1

Dim lLastrow As Long

Dim i As Long

Dim j As Integer

Sub cleanSheet()

    lLastrow = Sheets("Planilha1").Range("B" & Rows.Count).End(xlUp).Row
    
    For i = 1 To lLastrow
    
        If Right(Cells(i, 5).Value, 1) = "D" Then
        
            Cells(i, 2).Value = Cells(i + 1, 2).Value
            
        End If
    
    Next i
    
    For i = 1 To lLastrow
    
            If Right(Cells(i, 5).Value, 1) <> "C" And Right(Cells(i, 5).Value, 1) <> "D" Then
        
                    Rows(i).Select
                    Selection.Delete Shift:=xlUp

        End If

    Next i
    
    Cells(1, 1).Select
    
End Sub

Obrigado!