Macro para extraer texto de una hoja a otra pero a columnas no continuas.

Necesito una macro para extraer cierta información de la columna A que tiene cientos de filas, en cada celda tiene un texto inmenso pero la información que necesito se encuentra entre 4 caracteres son 2 # y dos comas(,)
Así se vuelven tres textos a extraer: un código que siempre empezara con un "HO" mas 8 dígitos, el segundo texto es una observación que varia el tamaño pero es el que se encuentra en las comas
y el tercer texto siempre sera una fecha y se encuentra después del segundo texto y antes del segundo #

Ejemplo:
                    Texto inmeso dentro de la celda#HO12345678, es una observación, fecha#
Al encontrar dicho texto extraiga a otra hoja del mismo libro, pero no en columnas continuas.
Por ejemplo el primer texto encontrado lo pegue en la columna B, el segundo texto en la columna F
y el tercer texto a la columna H.

Nota: la información a extraer no se encuentra en todas las celdas de la columna origen
ojala me puedan ayudar.

1 respuesta

Respuesta
1

Insisto es más fácil que pongas una imagen con tus datos no mencionas en que celda comienzan tus datos así que supongo que es en la hoja1 celda a1, esta macro leerá si tiene los 2# en caso de no ignorara ese dato y se moverá al siguiente dato, si existen entonces hará un segundo filtro cuyos resultados veras en la hoja 2 en las columnas que señalaste.

Sub extraer_y_copiar()
Set h1 = Worksheets("hoja1")
Set h2 = Worksheets("hoja2")
Set origen = h1.Range("a1").CurrentRegion
With origen
    filas = .Rows.Count
    x = 1
    For i = 1 To filas
        texto = .Cells(i, 1)
        separa = Split(texto, "#")
        cuenta = UBound(separa)
        If cuenta > 0 Then
        dsepara = Split(separa(1), ",")
        With h2
            .Range("b2").Cells(x, 1).Value = dsepara(0)
            .Range("f2").Cells(x, 1).Value = dsepara(1)
            .Range("h2").Cells(x, 1).Value = dsepara(2)
            x = x + 1
        End With
        End If
    Next i
End With
Set datos = Nothing
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas