Como pasar datos desde una hoja base a otras hojas del mismo libro
Necesito pasar desde una hoja base a otras hojas del mismo libro por un criterio algunos datos de la ésta.
A la hoja dotación debo pasar los datos de las columnas A, B, C, N y O de la hoja base. Primeramente debo filtrar por columna L, concepto 1000, antes de traspasar los datos utilizando macros.
A la hoja control debo pasar los datos de las columnas A hasta la K además de las columnas U, X, T. Primeramente debo filtrar por columna L, concepto 1000, antes de traspasar los datos.
A la hoja rentas debo pasar los datos de las columnas A, B, C, L, M, U y W de la hoja base. No hay que filtrar antes de traspasar los datos.
A la hoja asociación debo pasar los datos de las columnas A hasta la I además de las columnas P, Q, R, S y U de la hoja base. Primeramente debo filtrar por columna L, concepto 1000, antes de traspasar los datos.
A la hoja altas debo pasar los datos de las columnas A hasta la I además de las columnas N, O, M, U y X de la hoja base. Primeramente debo filtrar por columna L, concepto 1000, antes de traspasar los datos. En este casos la fecha de ingreso, columna X de la hoja base, debe ser igual o mayor a la fecha que se ingresará en la celda Y1 de esta hoja.
Hoja base
Hoja dotación
Hoja control
1 Respuesta
H o l a:
Te anexo la macro, no mencionaste en cuál fila de las hojas destino se tiene que poner las líneas, supongo que se tiene que poner en la siguiente fila disponible.
Dim hojas, h2, cols
Sub TraspasarDatos()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("base")
hojas = Array("dotacion", "control", "rentas", "asociacion", "altas")
For h = LBound(hojas) To UBound(hojas)
EstableceHoja h
'h2.Cells.Clear
k = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
n = 1
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
filtrado = False
Select Case h
Case 2
filtrado = True
Case 4
If h1.Cells(i, "L") = 1000 And h1.Cells(i, "X") >= h1.[Y1] Then
filtrado = True
End If
Case Else
If h1.Cells(i, "L") = 1000 Then
filtrado = True
End If
End Select
'
If filtrado Then
For j = LBound(cols) To UBound(cols)
Set r = Columns(cols(j))
For Each c In r.Columns
col = c.Column
h2.Cells(k, n) = h1.Cells(i, col)
n = n + 1
Next
Next
k = k + 1
End If
n = 1
Next
Next
MsgBox "Terminado"
End Sub
'
Sub EstableceHoja(h)
'Por.Dante Amor
Select Case h
Case 0
Set h2 = Sheets(hojas(h))
cols = Array("A", "B", "C", "N", "O") 'dotacion
Case 1
Set h2 = Sheets(hojas(h))
cols = Array("A:K", "U", "X", "T") 'control
Case 2
Set h2 = Sheets(hojas(h))
cols = Array("A", "B", "C", "L", "M", "U", "W") 'rentas
Case 3
Set h2 = Sheets(hojas(h))
cols = Array("A:I", "P", "Q", "R", "S", "U") 'asociacion
Case 4
Set h2 = Sheets(hojas(h))
cols = Array("A:I", "N", "O", "M", "U", "X") 'altas
End Select
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
Casi perfecto, salvo por un detalle.
Si genero el informe inicialmente sale correcto. Pero si vuelvo a generarlo teniendo datos iniciales me copia desde el ultimo registro copiado inicialmente, por lo que se me duplican los resultados.
Habría la posibilidad de que si existen datos en las hojas que se van a llenar primero borre los datos de éstas y posteriormente llenar con la información requerida. (Borrar sólo rango de columnas indicadas en consulta)
H o l a:
Con todo gusto le sigo realizando cambios a la macro. La macro es tanto compleja, te voy a actualizar la macro, pero si requieres más cambios deberás crear una nueva pregunta.
Dim hojas, h2, cols
Sub TraspasarDatos()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("base")
hojas = Array("dotacion", "control", "rentas", "asociacion", "altas")
For h = LBound(hojas) To UBound(hojas)
EstableceHoja h
h2.UsedRange.Offset(1, 0).ClearContents
k = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
n = 1
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
filtrado = False
Select Case h
Case 2
filtrado = True
Case 4
If h1.Cells(i, "L") = 1000 And h1.Cells(i, "X") >= h1.[Y1] Then
filtrado = True
End If
Case Else
If h1.Cells(i, "L") = 1000 Then
filtrado = True
End If
End Select
'
If filtrado Then
For j = LBound(cols) To UBound(cols)
Set r = Columns(cols(j))
For Each c In r.Columns
col = c.Column
h2.Cells(k, n) = h1.Cells(i, col)
n = n + 1
Next
Next
k = k + 1
End If
n = 1
Next
Next
MsgBox "Terminado"
End Sub
'
Sub EstableceHoja(h)
'Por.Dante Amor
Select Case h
Case 0
Set h2 = Sheets(hojas(h))
cols = Array("A", "B", "C", "N", "O") 'dotacion
Case 1
Set h2 = Sheets(hojas(h))
cols = Array("A:K", "U", "X", "T") 'control
Case 2
Set h2 = Sheets(hojas(h))
cols = Array("A", "B", "C", "L", "M", "U", "W") 'rentas
Case 3
Set h2 = Sheets(hojas(h))
cols = Array("A:I", "P", "Q", "R", "S", "U") 'asociacion
Case 4
Set h2 = Sheets(hojas(h))
cols = Array("A:I", "N", "O", "M", "U", "X") 'altas
End Select
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
