Necesito una macro que me una las filas para los registros iguales

Necesito una macro que me una las filas para los registros iguales por ejemplo:
EXpediente            Motivo
Idh-1500079 El CIF de la Comunidad de Propietarios del documento adjunto como factura no coincide con el informado en su solicitud.
Idh-1500079 El documento adjunto como Boletín de instalación no coincide con los datos informados en su solicitud.
Idh-1500079 El documento adjunto como Título constitutivo de la Comunidad no coincide con los datos informados en su solicitud.
Y debe quedar :
Idh-1500079 El CIF de la Comunidad de Propietarios del documento adjunto como factura no coincide con el informado en su solicitud.
                         El documento adjunto como Boletín de instalación no coincide con                          los datos informados en su solicitud.
                        El documento adjunto como Título constitutivo de la Comunidad                             no   coincide con los datos informados en su solicitud.
Que quede en una sola celda por expediente y así con toda la hoja y diversos expedientes

1 respuesta

Respuesta
1

H o l a:

Te anexo la macro.

Pon en la "Hoja1" tus datos, en la columna "A" pon los expedientes y en la columna "B" pon los motivos.

Crea una hoja llamada "Hoja2".

Ejecuta la macro y los resultados quedarán en la "Hoja2"

Sub UnirFilas()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    '
    h2.Cells.Clear
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        Set b = h2.Columns("A").Find(h1.Cells(i, "A"), lookat:=xlWhole)
        If Not b Is Nothing Then
            h2.Cells(b.Row, "B") = h2.Cells(b.Row, "B") & Chr(10) & h1.Cells(i, "B")
        Else
            u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
            h2.Cells(u, "A") = h1.Cells(i, "A")
            h2.Cells(u, "B") = h1.Cells(i, "B")
        End If
    Next
    h2.Columns("B:B").ColumnWidth = 100
    h2.Rows("2:" & u).EntireRow.AutoFit
    MsgBox "Proceso terminado", vbInformation, ""
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas