Macro:filtrar, copiar, pegar y concatenar.

En la hoja1 tengo este tipo de tabla:

Los valores de guía son valores únicos, y los valores de plaza se repiten.

El resultado que quiero optener es este:

Hoja 2

Ya que manualmente filtro, copio lo filtrado, lo pego en la hoja2 y concateno para que quede en una cadena separada por una ","

Agradezco su apoyo y respuestas. Ya que su labor es altruista.

1 Respuesta

Respuesta
2

¿En la hoja1 en qué columna está la guía y en qué columna está la plaza?

¿Y en la hoja2 en qué columnas quieres el resultado?

Te anexo la macro, cambia en la macro las columnas que se requieren.

Sub Concatenar()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    '
    c1 = "B"    'hoja1 columna guía
    c2 = "C"    'hoja1 columna plaza
    d1 = "B"    'hoja2 columna plaza
    d2 = "C"    'hoja2 columna guías concatenadas
    '
    h2.Columns(d1).ClearContents
    h2.Columns(d2).ClearContents
    '
    For i = 2 To h1.Range(c1 & Rows.Count).End(xlUp).Row
        Set b = h2.Columns(d1).Find(Cells(i, c2), lookat:=xlWhole)
        If Not b Is Nothing Then
            h2.Cells(b.Row, d2) = h2.Cells(b.Row, d2) & h1.Cells(i, c1) & ","
        Else
            u = h2.Range(d1 & Rows.Count).End(xlUp).Row + 1
            h2.Cells(u, d1) = h1.Cells(i, c2)
            h2.Cells(u, d2) = h1.Cells(i, c1) & ","
        End If
    Next
    h2.Select
    MsgBox "Terminado"
End Sub

Saludos.Dante Amor

Saludos gracias por tu tiempo, y esfuerzo, doy el dato que me falto.

En hoja 1

Guía columna A

Y plaza columna b

En hoja 2

Guías columna B

Plaza columna A

Quedaría así:

Sub Concatenar()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    '
    c1 = "A"    'hoja1 columna guía
    c2 = "B"    'hoja1 columna plaza
    d1 = "A"    'hoja2 columna plaza
    d2 = "B"    'hoja2 columna guías concatenadas
    '
    h2.Columns(d1).ClearContents
    h2.Columns(d2).ClearContents
    '
    For i = 2 To h1.Range(c1 & Rows.Count).End(xlUp).Row
        Set b = h2.Columns(d1).Find(Cells(i, c2), lookat:=xlWhole)
        If Not b Is Nothing Then
            h2.Cells(b.Row, d2) = h2.Cells(b.Row, d2) & h1.Cells(i, c1) & ","
        Else
            u = h2.Range(d1 & Rows.Count).End(xlUp).Row + 1
            h2.Cells(u, d1) = h1.Cells(i, c2)
            h2.Cells(u, d2) = h1.Cells(i, c1) & ","
        End If
    Next
    h2.Select
    MsgBox "Terminado"
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

Gracias es exactamente lo que necesito, pero tengo un problema, con pocas guías funciona fenomenal, pero al colocar más de 1000 guías no me concatena todas las guías y tampoco me trae la información de todas las pazas (son como 30 plazas)

Me aparece un cuadro de dialogo:

Error 13 en tiempo de ejecución:

No coinciden los tipos

Y al depurar se colorea amarillo:

Set b = h2.Columns(d1).Find(Cells(i, c2), lookat:=xlWhole)

La macro va revisando la columna A, guía por guía, desde la fila 2 hasta la última, puedes revisar hasta cuál fila llegó, es probable que tengas un dato erróneo en esa fila.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas