Macro extrae datos en base a criterios y concatena los datos obtenidos

Este procedimiento de VBA o macro de Excel, recorre todas las filas y todas las columnas del libro de Excel, buscando sólo celdas con datos, en caso de encontrarlas las coloca en la columna L y fila correspondiente, se saltea todas las celdas vacías y en caso de encontrar datos nuevamente antes del final de la búsqueda vuelve a copiar los datos en la columna siguiente a la L y así sucesivamente; la particularidad de la macro es que si encuentra datos los va concatenando y lo que guarda es una concatenación de todos los datos que no están vacío, es un ejemplo más de como recorrer celdas mediante bucles y obtener datos de acuerdo a ciertos criterios, esta pregunta me la hicieron en un foro y me pareció interesante agregarla para que puedan ver como trabaja el código, ya que además de que la celda contenga datos se debe tener en cuenta ir concatenando los resultados y hacer una cadena con esos datos, una vez que encuentra una celda vacía deja de concatenar y empieza nuevamente cuando encuentra una celda con datos, pero estos datos ya pertenecen a otra cadena de textos, haz click para bajar el ejemplo.

Te recomiendo que leas un excelente libro sobre Excel para ello haz click acá, si quieres un libro sobre Excel, en inglés, entonces debes hacer click acá.

El código que se encuentra a continuación se debe ingresar en un módulo, descargando el ejemplo lo podrás ver en funcionamiento, analizar, modificar y adaptar a lo que tú estés realizando el código está abierto sin ningún tipo de restricción.

Código a insertar en módulo

Sub extrae()
Dim fila, col1, col2, conta, conta1, conta2 As Integer
Dim str, strT As String
fila = 1
col1 = 1
col2 = 12
conta = 1
conta1 = 1
conta2 = 0
While conta < 20

   While conta1 < 10
        If Sheets(«hoja1»).Cells(fila, col1) <> Empty Then
           conta2 = 0
           str = Sheets(«hoja1»).Cells(fila, col1).Text
           strT = strT & str
           Sheets(«hoja1»).Cells(fila, col2) = strT
        Else
        conta2 = conta2 + 1
        strT = Empty
        End If

        If strT = Empty And Sheets(«hoja1»).Cells(fila, 12) <> Empty And conta2 = 1 Then
        col2 = col2 + 1
        End If
col1 = col1 + 1
conta1 = conta1 + 1
Wend

strT = Empty

fila = fila + 1
col1 = 1
col2 = 12
conta = conta + 1
conta1 = 1
conta2 = 0
Wend

End Sub

Si te fue de utilidad puedes INVITARME
UN CAFÉ y de esta manera ayudar a seguir
manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.

If this post was
helpful INVITE ME A COFFEE and so help keep
up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends