Traspasar datos de dos hojas a una tercera
Ojalá entiendas lo que necesito y me puedas ayudar.
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.
2 respuestas
Te anexo la macro actualizada. Pon las siguientes 2 macros en un módulo y ejecuta la macro Traspasar_Datos.
Sub Traspasar_Datos()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h3 = Sheets("Hoja3")
'
'Pasar de hoja1 a hoja3
cols1 = Array("F", "H", "I", "J", "K", "L", "N", "E")
col31 = Array("L", "J", "B", "C", "D", "E", "G", "H")
Call Copiar("Hoja1", h1, h3, 17, cols1, col31, "Q")
'
'Pasar de hoja2 a hoja3
cols1 = Array("O", "T", "A", "B", "C", "D", "F", "L")
col31 = Array("M", "K", "B", "C", "D", "E", "G", "H")
Call Copiar("Hoja2", h1, h3, 8, cols1, col31, "H")
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
'
Sub Copiar(hoja, h1, h3, col, cols1, col31, cof)
'Por.Dante Amor
Set h1 = Sheets(hoja)
u3 = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
If h1.AutoFilterMode Then h1.AutoFilterMode = False
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("A1:T" & u1).AutoFilter Field:=col, Criteria1:="<>traspasado"
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
If u1 > 1 Then
For j = LBound(cols1) To UBound(cols1)
h1.Range(h1.Cells(2, cols1(j)), h1.Cells(u1, cols1(j))).Copy h3.Cells(u3, col31(j))
Next
u4 = h3.Range("B" & Rows.Count).End(xlUp).Row
h3.Range(h3.Cells(u3, "A"), h3.Cells(u4, "A")) = h1.Name
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range(cof & "2:" & cof & u1) = "traspasado"
End If
If h1.AutoFilterMode Then h1.AutoFilterMode = False
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
La ejecución en tiempo, bárbaro, en un pis-pas pero me ha copiado y pegado las fórmulas en vez de los datos. Cómo hago para que copie los valores en vez de las fórmulas??? Gracias
Ah, y me equivoqué de columna para el "traspasado" del segundo proceso. Debía ir a la columna U en vez de a la H.
Gracias
Van
Sub Traspasar_Datos()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h3 = Sheets("Hoja3")
'
'Pasar de hoja1 a hoja3
cols1 = Array("F", "H", "I", "J", "K", "L", "N", "E")
col31 = Array("L", "J", "B", "C", "D", "E", "G", "H")
Call Copiar("Hoja1", h1, h3, 17, cols1, col31, "Q")
'
'Pasar de hoja2 a hoja3
cols1 = Array("O", "T", "A", "B", "C", "D", "F", "L")
col31 = Array("M", "K", "B", "C", "D", "E", "G", "H")
Call Copiar("Hoja2", h1, h3, 8, cols1, col31, "U")
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
'
Sub Copiar(hoja, h1, h3, col, cols1, col31, cof)
'Por.Dante Amor
Set h1 = Sheets(hoja)
u3 = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
If h1.AutoFilterMode Then h1.AutoFilterMode = False
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("A1:U" & u1).AutoFilter Field:=col, Criteria1:="<>traspasado"
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
If u1 > 1 Then
For j = LBound(cols1) To UBound(cols1)
h1.Range(h1.Cells(2, cols1(j)), h1.Cells(u1, cols1(j))).Copy
h3.Cells(u3, col31(j)).PasteSpecial xlValues
Next
u4 = h3.Range("B" & Rows.Count).End(xlUp).Row
h3.Range(h3.Cells(u3, "A"), h3.Cells(u4, "A")) = h1.Name
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range(cof & "2:" & cof & u1) = "traspasado"
End If
If h1.AutoFilterMode Then h1.AutoFilterMode = False
End Subsal u dos
¡Gracias! Si puedes echa un vistazo a las dos nuevas preguntas que te envié. Cuestión de 2 minutos para ti e importantes para mi.
Estoy desarrollando una macro para trasladar datos de columnas especificas de la Hoja "Notas" a la hoja "EvaLapso1", que funcionaba perfectamente cuando en la hoja Notas no estaba con formato Tabla. Luego de convertirla a tabla entonces no me corre y sale un error 1004 en tiempo de ejecucion y error en el metodo AdvenceFilter de la Clase Range.
Es un solo archivo, la Hoja Notas tiene 131 columnas y EvaLapso1 tiene 42 columnas. Criterios de busqueda columna 109(DE) y debe copiar en la hoja EvaLapso1 las columnas 1, 107, 108, 109, 110, 111, 33, 38, 43, 48, 53, 58, 73, 83, 88; 34, 39, 44, 49, 54, 59, 74, 84, 89; 35 40, 45, 50, 55, 60, 75, 85, 90; 36 41, 46, 51, 56, 61, 76, 86, 91 de la hoja Notas.