Macro agrupar valores iguales

stratonauta · el 26 de febrero

Tengo excel con varias columnas:

Fincas/Polígono/Parcela/Titular/Domicilio

Se trata de una Macro que identifique los datos repetidos de la columna "Titular" y agrupe en una sola fila los datos que tenga de Finca/Polígonos/Parcelas.. en otra fila diferente.

Finca Pol. Parc. Titular Agrup. Finca/s Pol. Agrup. Parc. Agrup. Titular

1 12 35 Abdon Terrades 1,5 12, 12 35, 41 Abdón Terrades

5 12 41 Abdon Terrades

JSDJSD · el 26 de febrero

Sube tu archivo

stratonauta · el 27 de febrero

Muchas gracias, por adelantado.

Saludos,

BD GETAFE.xlsx

JSDJSD · el 27 de febrero

A ver si es esto lo que buscas

JSDJSD · el 27 de febrero

Sub Agrupar(): Application.ScreenUpdating = False

    Hoja3.Cells.Clear
    
    With Hoja1
        Set tbl = .ListObjects("Tabla1")
        Set Rng = tbl.Range
        tbl.Unlist
        Set tbl = Nothing
        uf = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:H" & uf).Copy Destination:=Hoja3.Range("A1")
        Set tbl = .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes)
        tbl.Name = "Tabla1"
    End With
    
    With Hoja3
        .Range("A:H").Sort Key1:=.Columns("G"), Order1:=xlAscending, Header:=xlYes
        For X = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1
            If Trim(.Range("G" & X)) = Trim(.Range("G" & X - 1)) Then
                .Range("C" & X - 1) = .Range("C" & X - 1) & "," & .Range("C" & X)
                .Range("D" & X - 1) = .Range("D" & X - 1) & "," & .Range("D" & X)
                .Range("E" & X - 1) = .Range("E" & X - 1) & "," & .Range("E" & X)
                .Range("F" & X - 1) = .Range("F" & X - 1) & "," & .Range("F" & X)
                .Rows(X).Delete
            End If
        Next
        .Range("A1", "H" & .Range("A" & .Rows.Count).End(xlUp).Row).Rows.AutoFit
        .Range("A1", "H" & .Range("A" & .Rows.Count).End(xlUp).Row).Columns.AutoFit
    End With
End Sub

BD GETAFE.xlsm