Traspasar datos de dos hojas a una tercera mediante macro

.

Para Dante Amor.

Hola Dante Amor, ya hice la consulta en otra pregunta en todoexpertos pero no obtuve respuesta y quería persistir en el intento pues no logro encontrar la forma de hacerlo. Estoy iniciándome en VBA pero mis necesidades van más rápido que mi capacidad de aprendizaje.

Si ves esta pregunta y puedes ayudarme te estaría eternamente agradecido.

Tengo una "hoja3" a la que quiero traer, mediante una macro, los datos de determinadas columnas de la "hoja1" y de la "hoja2" y colocarlos en determinadas columnas de la hoja3.

En un primer proceso de la "hoja1" quiero pasar todos los datos de las filas de las columnas F, H, I, J, K, L, N y E a las columnas L, J, B, C, D, E, G y H de la "hoja3" respectivamente (guardando el formato del origen).

En un segundo proceso de la "hoja2" quiero pasar todos los datos de las filas de las columnas O, T, A, B, C, D, F y L a las columnas M, K, B, C, D, E, G y H de la "hoja3" respectivamente (guardando el formato del origen).

Una vez terminado el traslado de datos poner en la columna A de la "hoja3" el nombre de la hoja de la que provienen los datos, es decir, "hoja1" en el primer proceso y "hoja2" en el segundo proceso (en todas y cada una de las filas traspasadas)

Y, por último, poner "traspasado" en la columna Q de la "hoja1" (en cada una de las filas que ha sido traspasada) en el primer proceso y poner "traspasado" en la columna H de la hoja2.

Esto para que, al volver a ejecutar la macro, lea antes de traspasar los datos si ya ha sido realizado con anterioridad

1 Respuesta

Respuesta
2

Te anexo la macro

Sub Traspasar_Datos()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    Set h3 = Sheets("Hoja3")
    '
    cols1 = Array("F", "H", "I", "J", "K", "L", "N", "E")
    col31 = Array("L", "J", "B", "C", "D", "E", "G", "H")
    cols2 = Array("O", "T", "A", "B", "C", "D", "F", "L")
    col32 = Array("M", "K", "B", "C", "D", "E", "G", "H")
    '
    'Pasar de hoja1 a hoja3
    u = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
    For i = 2 To h1.Range("F" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "Q") <> "traspasado" Then
            For j = LBound(cols1) To UBound(cols1)
                h3.Cells(u, col31(j)) = h1.Cells(i, cols1(j))
            Next
            h3.Cells(u, "A") = h1.Name
            h1.Cells(i, "Q") = "traspasado"
            u = u + 1
        End If
    Next
    'Pasar de hoja2 a hoja3
    u = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
    For i = 2 To h1.Range("O" & Rows.Count).End(xlUp).Row
        If h2.Cells(i, "H") <> "traspasado" Then
            For j = LBound(cols2) To UBound(cols2)
                h3.Cells(u, col32(j)) = h2.Cells(i, cols2(j))
            Next
            h3.Cells(u, "A") = h2.Name
            h2.Cells(i, "H") = "traspasado"
            u = u + 1
        End If
    Next
    MsgBox "Fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Gracias Dante, la macro funciona perfectamente y hace exactamente lo que te pedí.

Solo un "pequeño" pero, las filas que tengo que traspasar de la hoja 1 a la 3 son 130.088 y de la hoja 2 a la 3 son 4.847. Lleva nueve horas ejecutándose y vá por la fila 10.191 del primer proceso.

¿puede ser por capacidad de mi ordenador?

¿se puede agilizar de alguna manera?

Prácticamente tendría que hacer otra macro con otra lógica. Lo reviso y te envío otra macro

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas