Excel Macro concatenar com loop

[jeffersondaluza]

Caros, bom dia!

 

Estou com um problema pra resolver aqui no trabalho.

Seguinte: a tabela abaixo está nesse formato para umas 500 linhas. Eu preciso mesclar as linhas que estão sem contorno pra uma só, a primeira de cada contorno. 

A coluna B tem sempre o primeiro dado preenchido, imagino que isso facilite na contagem do loop. Pensei em contar as células vazias até achar uma com dado, daí concatena as células da coluna C para a primeira e depois apago as linhas vazias. Só não sei fazer isso com a macro. ='(

Alguém pode ajudar? Saudações!

 

 

 

[EDIT] Preciso que fique assim:

 

[Midori]

Coloque o exemplo feito de um caso.

 

Assim fica mais fácil ajudar para os demais casos.

[jeffersondaluza]

@olliver.soul Coloquei como deveria ficar. Lembrando que é uma planilha bem grande, e as linhas a serem concatenadas não possuem a mesma quantidade de células, como se pode ver de um para o outro.

[Midori]

Teste essa macro.

 

Considerei a coluna 3 onde os textos devem ser concatenados.

 

Sub Main()
    Dim C           As Range
    Dim rCelula     As Range
    Dim strTexto    As String
    
    For Each C In Range("C1:C" & Range("C60000").End(xlUp).Row)
        If C.Offset(, -1) <> "" And C.Offset(1, -2) = "" Then
            Set rCelula = C
            strTexto = C
        Else
            strTexto = strTexto & C
            If C.Offset(, 2) = "" Then
                rCelula.Value = strTexto
                Range("C" & rCelula.Row + 1 & ":C" & C.Row).Clear
            End If
        End If
    Next C
End Sub

 

[jeffersondaluza]

2 horas atrás, olliver.soul disse:

Teste essa macro.

 

Considerei a coluna 3 onde os textos devem ser concatenados.

 

Sub Main()
    Dim C           As Range
    Dim rCelula     As Range
    Dim strTexto    As String
    
    For Each C In Range("C1:C" & Range("C60000").End(xlUp).Row)
        If C.Offset(, -1) <> "" And C.Offset(1, -2) = "" Then
            Set rCelula = C
            strTexto = C
        Else
            strTexto = strTexto & C
            If C.Offset(, 2) = "" Then
                rCelula.Value = strTexto
                Range("C" & rCelula.Row + 1 & ":C" & C.Row).Clear
            End If
        End If
    Next C
End Sub

 

Funcionou para boa parte dos casos, mas por algum motivo ele pulou alguns e não concatenou. Mas já ta ajudando bastante. 

Valeu mesmo mano.