Precisa de código VBA para combinar linhas se as linhas A-F forem as mesmas

Question

Eu preciso de um código VBA que combine linhas se, por exemplo, Rows 4 & 5 têm os mesmos valores nas colunas A: F. No entanto, preciso que a coluna G seja dividida. G4 permanece como G4, mas então G5 se torna H5. Eu fiz alguma codificação VBA (e já alterei a planilha como visto no meu código abaixo), mas não tenho idéia de por onde começar com o próximo sub.

Isto é o que eu tenho:

Issoéoqueeupreciso:

SubDeleteRowWithContents()Last=Cells(Rows.Count,"J").End(xlUp).Row
    For i = Last To 1 Step -1
        If (Cells(i, "N").Value) = "Abandon Order" Or (Cells(i, "N").Value) = "Inactive" Then
            Cells(i, "A").EntireRow.Delete
        End If
    Next i
End Sub

Sub DeleteNoNeedColumns ()
    Columns("J:N").EntireColumn.Delete
    Columns("H").EntireColumn.Delete

End Sub

Sub Concat()
    iRow = 2
    Do
        Cells(iRow, 9) = Cells(iRow, 7) & " " & Cells(iRow, 8)
        iRow = iRow + 1
    Loop Until IsEmpty(Cells(iRow, 1))
End Sub

Sub AddProductHeader ()
    Cells(1,9).Value2 = "'product_total"
End Sub

Sub DeleteProductColumns ()
    Columns("G:H").EntireColumn.Delete
End Sub

    

Answer 1

Isso deve funcionar:

Sub mergeproducts()
    Dim a As Application
    Set a = Application
    Dim wks As Worksheet
    Set wks = ActiveSheet
    wks.Application.ScreenUpdating = False
    max_col = 6
    Last = Cells(Rows.Count, "A").End(xlUp).Row
    For i = Last To 2 Step -1
        row_b = Join(a.Transpose(a.Transpose(wks.Range(Cells(i, 1), Cells(i, max_col)))), Chr(0))
        For j = i - 1 To 1 Step -1
            row_a = Join(a.Transpose(a.Transpose(wks.Range(Cells(j, 1), Cells(j, max_col)))), Chr(0))
            If row_a = row_b Then
                k = max_col + 1
                full = True
                    While full
                        If wks.Cells(i, k) = "" Then
                            wks.Cells(i, k) = wks.Cells(j, max_col + 1)
                            full = False
                        Else
                            k = k + 1
                        End If
                    Wend
                wks.Rows(j).Delete
                j = 1
            End If
        Next j
    Next i
    wks.Application.ScreenUpdating = True
    Final = MsgBox("Finished", vbInformation)
End Sub