Combine várias linhas em uma

Question

Estou tentando combinar várias linhas de dados em uma. A coluna A contém o valor no qual os agrupamentos serão baseados - as linhas com as quais os valores da coluna A coincidem serão combinadas em uma linha. Meu intervalo se estende da coluna A até o X, portanto, preciso de uma linha de dados correspondente para iniciar na coluna Y.

Exemplo:

╔══════╦═══╦═══╗
║ 1001 ║ A ║ C ║
║ 1001 ║ B ║ D ║
║ 1002 ║ A ║ E ║
║ 1002 ║ B ║ F ║
║ 1002 ║ C ║ G ║
╚══════╩═══╩═══╝

Resultado desejado:

╔══════╦═══╦═══╦═══╦═══╦═══╦═══╗
║ 1001 ║ A ║ C ║ B ║ D ║   ║   ║
║ 1002 ║ A ║ E ║ B ║ F ║ C ║ G ║
╚══════╩═══╩═══╩═══╩═══╩═══╩═══╝

O código do VBA que estou usando atualmente não está recebendo todo o conteúdo da linha correspondente. É só pegar os dados na segunda coluna e movê-los.

Código VBA:

Sub Mergeitems()

    Dim cl As Range
    Dim rw As Range

    Set rw = ActiveCell

    Do While rw <> ""
        ' for each row in data set
        '   find first empty cell on row
        Set cl = rw.Offset(0, 1)
        Do While cl <> ""
            Set cl = cl.Offset(0, 1)
        Loop

        ' if next row needs to be processed...
        Do While rw = rw.Offset(1, 0)
            cl = rw.Offset(1, 1)       ' move the data
            Set cl = cl.Offset(0, 1)   ' update pointer to next blank cell
            rw.Offset(1, 0).EntireRow.Delete xlShiftUp   ' delete old data
        Loop

        ' next row
        Set rw = rw.Offset(1, 0)
    Loop
End Sub

    

Answer 1

Eu provavelmente abordaria seu problema geral (mesclando linhas) com uma macro totalmente diferente, mas aqui estão as linhas que você pode alterar em seu código:

cl = rw.Offset(1, 1)       ' move the data
Set cl = cl.Offset(0, 1)   ' update pointer to next blank cell
rw.Offset(1, 0).EntireRow.Delete xlShiftUp   ' delete old data

Tente substituí-los por isso:

i = 1
Do While rw.Offset(1, i) <> "" 
    cl = rw.Offset(1, i)      
    Set cl = cl.Offset(0, 1)  
    i = i + 1
Loop
rw.Offset(1, 0).EntireRow.Delete xlShiftUp  'delete old data

Resultado: