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
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