Как объединить значения из нескольких строк в одну строку с помощью модуля?

Question

Я ищу, чтобы объединить несколько строк в одну строку на основе значения в столбце кода .. Я заметил другие вопросы здесь, похожие на мой вопрос, но я не могу расширить диапазон ..

Code    Name    Value A Value B Value C Value D Value E
101   Example      #                
101   Example                       
101   Example                     #     
101   Example                            #  
101   Example                                    #
102   Example2                                   #
102   Example2                           #  
102   Example2                    #     
102   Example2            #         
102   Example2     #

Итак, конечный результат выглядит так:

Code    Name    Value A Value B Value C Value D Value E
101    Example     #               #       #       #
102    Example2    #       #       #       #       #

редактировать

Это то, что я получил до сих пор, мой план состоял в том, чтобы переместить элементы в строку выше, прежде чем удалять всю строку, так как в одной строке может быть много элементов.

Dim RowNum, LastRow, Col As Long

RowNum = 2
Col = 3

LastRow = Cells.SpecialCells(xlCellTypeLastCell).row
Range("A2", Cells(LastRow, 7)).Select

For Each row In Selection
    With Cells
        If Cells(RowNum, 1) = Cells(RowNum + 1, 1) Then
            For Each Cell In row
                If Cell > 0 Then
                Cells(RowNum + 1, Col).Copy Destination:=Cells(RowNum, Col)
                Else
                Col = Col + 1
            End If
        Rows(RowNum + 1).EntireRow.Delete
        End If
  End With

RowNum = RowNum + 1

Next row

Answer 1

Мне немного стыдно за ответ, на котором вы основали свой код. Сделайте резервную копию ваших данных и протестируйте их!

Это должно работать:

Sub combine()

Dim c As Range
Dim i As Integer

For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
If c = c.Offset(1) And c <> "" Then
       For i = 1 To 6
            If c.Offset(1, i) <> "" Then
                c.Offset(, i) = c.Offset(1, i)
            End If
       Next
       c.Offset(1).EntireRow.Delete
End If

Next

End Sub