Copiar celdas y pegarlos en sig hojas
Hola, espero me puedan ayudar:
Tengo un libro que el la primer hoja tiene una tabla con 3 columnas, quisiera una macro que copiara los valores de A2, B2, C2, y los pegue en la siguiente hoja, luego copie los valores de A3, B3, C3, y los pegue en la hoja 3, y así sucesivamente, y se detenga al llegar a una fila vacía, es decir cuando ya no haya datos en la tabla, y al pegarlos en las siguientes hojas que no estén en fila, es decir, que los pegue en diferentes celdas, por ejemplo E3, F6, G9.
¿Es posible hacer esto en una sola macro? Si no se puede, por lo menos hacer una macro que copie el valor de una celda, lo pegue en la siguiente hoja, baje a la siguiente fila, copie el valor y lo pegue en la hoja 3, etc... Aunque tenga que tener 3 diferentes macros para los 3 diferentes valores que quiero copiar.
Gracias!
Tengo un libro que el la primer hoja tiene una tabla con 3 columnas, quisiera una macro que copiara los valores de A2, B2, C2, y los pegue en la siguiente hoja, luego copie los valores de A3, B3, C3, y los pegue en la hoja 3, y así sucesivamente, y se detenga al llegar a una fila vacía, es decir cuando ya no haya datos en la tabla, y al pegarlos en las siguientes hojas que no estén en fila, es decir, que los pegue en diferentes celdas, por ejemplo E3, F6, G9.
¿Es posible hacer esto en una sola macro? Si no se puede, por lo menos hacer una macro que copie el valor de una celda, lo pegue en la siguiente hoja, baje a la siguiente fila, copie el valor y lo pegue en la hoja 3, etc... Aunque tenga que tener 3 diferentes macros para los 3 diferentes valores que quiero copiar.
Gracias!
1 Respuesta
Respuesta de santiagomf
1
No acabo de entender cual sería la primera celda de destino en la que quieres copiar los datos, pero empecemos por el principio.
Prueba este código:
Option Explicit
Sub copiaFilasTablaEnHojasSeparadas()
Dim nLin As Integer
Dim hojaTabla As Worksheet
Dim nomHojaDestino As String
Set hojaTabla = Sheets("hoja1")
nLin = 2
Do While hojaTabla.Cells(nLin, 1)
' Mientras tenga algo en la línea "nLin" y columna 1 (A)
nomHojaDestino = "Hoja" & Format$(nLin)
preparaPagina nomHojaDestino ' Preparamos la página para copiar los datos
' Y ahora los copiamos
Sheets(nomHojaDestino).Cells(1, 1) = hojaTabla(nLin, 1)
Sheets(nomHojaDestino).Cells(1, 2) = hojaTabla(nLin, 2)
Sheets(nomHojaDestino).Cells(1, 3) = hojaTabla(nLin, 3)
nLin = nLin + 1
Loop
MsgBox "Proceso terminado"
End Sub
Private Sub preparaPagina(ByVal nomHoja As String)
Dim i As Integer
For i = 1 To ThisWorkbook.Sheets.Count ' Miramos todas las páginas del libro
If UCase$(nomHoja) = UCase$(ThisWorkbook.Sheets(i).Name) Then Exit For
Next i
If i > ThisWorkbook.Sheets.Count Then
' La hoja no exista, tendremos que crearla nueva
ThisWorkbook.Sheets.Add
ActiveSheet.Name = nomHoja
Else
' Borramos el contenido anterior de las celdas de la hoja que ya existe
Sheets(nomHoja).Cells.Delete
End If
End Sub
Como verás, al final tiene un procedimiento que comprueba si existe la hoja de destino y, en caso de no encontrarla, la crearía. Esto lo he preparado en un 'private sub' que hace que el código sea inaccesible desde otros módulos ni se pueda ejecutar como una macro más.
Si no quieres que esté separado, se podría incluir su código dentro del procedimiento anterior, pero hacer procedimientos demasiado largos sólo provoca errores.
Vamos a por otro tema. El código anterior te copia las celdas "A2, B2 y C2" en la página "Hoja2" en las celdas "A1, B1 y C1"; copia "A3, B3 y C3" en la página "Hoja3" celdas "A1, B1 y C1". Como verás siempre los copia a la fila 1.
Si quieres que los copie en otras filas y/o columnas, tendrás que variar los valores (1,1), (1,2) y (1,3) de las instrucciones:
Sheets(nomHojaDestino).Cells(1, 1) = hojaTabla(nLin, 1)
Sheets(nomHojaDestino).Cells(1, 2) = hojaTabla(nLin, 2)
Sheets(nomHojaDestino).Cells(1, 3) = hojaTabla(nLin, 3)
Esos valores envían el dato a la fila 1 columna 1(A), 2(B) y 3(C).
Si quieres que los datos se copien en las celdas "E3, F3 y G3" de la "hoja2", en las celdas "F4, G4 y H4" de "hoja3", en "G5, H5 e I5" de la "hoja4"... creo que es algo así lo que dices, podrías poner un código como este:
Sheets(nomHojaDestino).Cells(nLin + 1, nLin + 3) = hojaTabla(nLin, 1)
Sheets(nomHojaDestino).Cells(nLin + 1, nLin + 4) = hojaTabla(nLin, 2)
Sheets(nomHojaDestino).Cells(nLin + 1, nLin + 5) = hojaTabla(nLin, 3)
De esa forma la fila y columna de destino variará dependiendo de la línea que estés copiando.
Se que es un poco jaleo, pero espero haberte entendido bien y haberme explicado suficientemente.
Prueba este código:
Option Explicit
Sub copiaFilasTablaEnHojasSeparadas()
Dim nLin As Integer
Dim hojaTabla As Worksheet
Dim nomHojaDestino As String
Set hojaTabla = Sheets("hoja1")
nLin = 2
Do While hojaTabla.Cells(nLin, 1)
' Mientras tenga algo en la línea "nLin" y columna 1 (A)
nomHojaDestino = "Hoja" & Format$(nLin)
preparaPagina nomHojaDestino ' Preparamos la página para copiar los datos
' Y ahora los copiamos
Sheets(nomHojaDestino).Cells(1, 1) = hojaTabla(nLin, 1)
Sheets(nomHojaDestino).Cells(1, 2) = hojaTabla(nLin, 2)
Sheets(nomHojaDestino).Cells(1, 3) = hojaTabla(nLin, 3)
nLin = nLin + 1
Loop
MsgBox "Proceso terminado"
End Sub
Private Sub preparaPagina(ByVal nomHoja As String)
Dim i As Integer
For i = 1 To ThisWorkbook.Sheets.Count ' Miramos todas las páginas del libro
If UCase$(nomHoja) = UCase$(ThisWorkbook.Sheets(i).Name) Then Exit For
Next i
If i > ThisWorkbook.Sheets.Count Then
' La hoja no exista, tendremos que crearla nueva
ThisWorkbook.Sheets.Add
ActiveSheet.Name = nomHoja
Else
' Borramos el contenido anterior de las celdas de la hoja que ya existe
Sheets(nomHoja).Cells.Delete
End If
End Sub
Como verás, al final tiene un procedimiento que comprueba si existe la hoja de destino y, en caso de no encontrarla, la crearía. Esto lo he preparado en un 'private sub' que hace que el código sea inaccesible desde otros módulos ni se pueda ejecutar como una macro más.
Si no quieres que esté separado, se podría incluir su código dentro del procedimiento anterior, pero hacer procedimientos demasiado largos sólo provoca errores.
Vamos a por otro tema. El código anterior te copia las celdas "A2, B2 y C2" en la página "Hoja2" en las celdas "A1, B1 y C1"; copia "A3, B3 y C3" en la página "Hoja3" celdas "A1, B1 y C1". Como verás siempre los copia a la fila 1.
Si quieres que los copie en otras filas y/o columnas, tendrás que variar los valores (1,1), (1,2) y (1,3) de las instrucciones:
Sheets(nomHojaDestino).Cells(1, 1) = hojaTabla(nLin, 1)
Sheets(nomHojaDestino).Cells(1, 2) = hojaTabla(nLin, 2)
Sheets(nomHojaDestino).Cells(1, 3) = hojaTabla(nLin, 3)
Esos valores envían el dato a la fila 1 columna 1(A), 2(B) y 3(C).
Si quieres que los datos se copien en las celdas "E3, F3 y G3" de la "hoja2", en las celdas "F4, G4 y H4" de "hoja3", en "G5, H5 e I5" de la "hoja4"... creo que es algo así lo que dices, podrías poner un código como este:
Sheets(nomHojaDestino).Cells(nLin + 1, nLin + 3) = hojaTabla(nLin, 1)
Sheets(nomHojaDestino).Cells(nLin + 1, nLin + 4) = hojaTabla(nLin, 2)
Sheets(nomHojaDestino).Cells(nLin + 1, nLin + 5) = hojaTabla(nLin, 3)
De esa forma la fila y columna de destino variará dependiendo de la línea que estés copiando.
Se que es un poco jaleo, pero espero haberte entendido bien y haberme explicado suficientemente.
Santiago, muchas gracias por tu respuesta, sin embargo creo que tengo que explicarme mejor, espero me puedas ayudar:
Mi libro tiene 2 hojas, la primera se llama "Tabla" en la que hay una tabla de 3 columnas con diferentes valores, la segunda hoja llamada "formato" tiene un formato donde van los datos de la tabla. Lo que necesito es que una macro que:
1)Lea el valor de A2, B2, C2
2)Copie la hoja "formato" y la renombre con el valor de A2
3)En la nueva hoja pegue los valores de A2, B2, y C2 en B14, C14, y H14
4)Lea el valor de A3, B3, C3
5)Haga una nueva copia de la hoja "formato" y la renombre con el valor de A3
6)En la nueva hoja pegue los valores de A3, B3, y C3 en B14, C14, y H14
7)Repita todo lo anterior hasta que ya no encuentre valores en la tabla
He conseguido hacer una parte con el siguiente código de Elsa, el cual modifique un poco:
Sub COPIARHOJAS()
Sheets("Tabla").Select
Range("A2").Select
While ActiveCell <> ""
nombreHoja = ActiveCell.Value
On Error Resume Next
Hoja1.Select
Sheets("Formato").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = nombreHoja
Sheets("Tabla").Select
ActiveCell.Offset(1, 0).Select
Wend
End Sub
Con el código anterior logro que lea A2, copie la hoja "formato" y la renombre con el valor de A2, lea A3 y copie la hoja "formato" y la renombre con el valor de A3, y así sucesivamente hasta que ya no hay datos en la tabla. Ahora solo me falta lograr que lea A2, B2, C2, y los copie en B14, C14, y H14, lea A3, B3, C3, y los copie en B14, C14, y H14, y así hasta que no haya más datos.
Espero haberme explicado mejor, y ojala puedas ayudarme.
Gracias de antemano, saludos.
Mi libro tiene 2 hojas, la primera se llama "Tabla" en la que hay una tabla de 3 columnas con diferentes valores, la segunda hoja llamada "formato" tiene un formato donde van los datos de la tabla. Lo que necesito es que una macro que:
1)Lea el valor de A2, B2, C2
2)Copie la hoja "formato" y la renombre con el valor de A2
3)En la nueva hoja pegue los valores de A2, B2, y C2 en B14, C14, y H14
4)Lea el valor de A3, B3, C3
5)Haga una nueva copia de la hoja "formato" y la renombre con el valor de A3
6)En la nueva hoja pegue los valores de A3, B3, y C3 en B14, C14, y H14
7)Repita todo lo anterior hasta que ya no encuentre valores en la tabla
He conseguido hacer una parte con el siguiente código de Elsa, el cual modifique un poco:
Sub COPIARHOJAS()
Sheets("Tabla").Select
Range("A2").Select
While ActiveCell <> ""
nombreHoja = ActiveCell.Value
On Error Resume Next
Hoja1.Select
Sheets("Formato").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = nombreHoja
Sheets("Tabla").Select
ActiveCell.Offset(1, 0).Select
Wend
End Sub
Con el código anterior logro que lea A2, copie la hoja "formato" y la renombre con el valor de A2, lea A3 y copie la hoja "formato" y la renombre con el valor de A3, y así sucesivamente hasta que ya no hay datos en la tabla. Ahora solo me falta lograr que lea A2, B2, C2, y los copie en B14, C14, y H14, lea A3, B3, C3, y los copie en B14, C14, y H14, y así hasta que no haya más datos.
Espero haberme explicado mejor, y ojala puedas ayudarme.
Gracias de antemano, saludos.
Creo que, si no te he entendido mal, el código que buscas podría ser este:
Sub copiaFilasTablaEnHojasSeparadas()
Dim nLin As Integer
Dim hojaTabla As Worksheet
Dim nomHojaDestino As String
Set hojaTabla = Sheets("Tabla")
nLin = 2
Do While hojaTabla.Cells(nLin, 1)
' Mientras tenga algo en la línea "nLin" y columna 1 (A)
nomHojaDestino = hojaTabla.Cells(nLin, 1)
preparaPaginaCopiaFormato nomHojaDestino ' Preparamos la página
' Y ahora copiamos los 3 datos
Sheets(nomHojaDestino).Cells(14, 2) = hojaTabla(nLin, 1)
Sheets(nomHojaDestino).Cells(14, 3) = hojaTabla(nLin, 2)
Sheets(nomHojaDestino).Cells(14, 8) = hojaTabla(nLin, 3)
nLin = nLin + 1
Loop
MsgBox "Proceso terminado"
End Sub
Private Sub preparaPaginaCopiaFormato(ByVal nomHoja As String)
Dim i As Integer
' Antes de nada miraremos si ya existe la hoja indicada, en cuyo caso la borraremos
For i = 1 To ThisWorkbook.Sheets.Count ' Miramos todas las páginas del libro
If UCase$(nomHoja) = UCase$(ThisWorkbook.Sheets(i).Name) Then Exit For
Next i
If i <= ThisWorkbook.Sheets.Count Then
' La hoja existe, la borramos
ThisWorkbook.Sheets(i).Delete
End If
' Ahora ya podemos crear la hoja haciendo una copia de la página 'formato'
Sheets("Formato").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = nomHoja
End Sub
Ya me contarás.
Sub copiaFilasTablaEnHojasSeparadas()
Dim nLin As Integer
Dim hojaTabla As Worksheet
Dim nomHojaDestino As String
Set hojaTabla = Sheets("Tabla")
nLin = 2
Do While hojaTabla.Cells(nLin, 1)
' Mientras tenga algo en la línea "nLin" y columna 1 (A)
nomHojaDestino = hojaTabla.Cells(nLin, 1)
preparaPaginaCopiaFormato nomHojaDestino ' Preparamos la página
' Y ahora copiamos los 3 datos
Sheets(nomHojaDestino).Cells(14, 2) = hojaTabla(nLin, 1)
Sheets(nomHojaDestino).Cells(14, 3) = hojaTabla(nLin, 2)
Sheets(nomHojaDestino).Cells(14, 8) = hojaTabla(nLin, 3)
nLin = nLin + 1
Loop
MsgBox "Proceso terminado"
End Sub
Private Sub preparaPaginaCopiaFormato(ByVal nomHoja As String)
Dim i As Integer
' Antes de nada miraremos si ya existe la hoja indicada, en cuyo caso la borraremos
For i = 1 To ThisWorkbook.Sheets.Count ' Miramos todas las páginas del libro
If UCase$(nomHoja) = UCase$(ThisWorkbook.Sheets(i).Name) Then Exit For
Next i
If i <= ThisWorkbook.Sheets.Count Then
' La hoja existe, la borramos
ThisWorkbook.Sheets(i).Delete
End If
' Ahora ya podemos crear la hoja haciendo una copia de la página 'formato'
Sheets("Formato").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = nomHoja
End Sub
Ya me contarás.
Gracias por tu ayuda, te comento:
Soy bastante nuevo en esto de las macros, así que mañana estudiare el código que pones, mientras, hoy estuve jugando con lo que tenia y logre una solución a lo que estaba buscando, este es mi código:
Sub GENERAR()
Sheets("Tabla").Select
Range("A2").Select
While ActiveCell <> ""
nombreHoja = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
desConcepto = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
uniConcepto = ActiveCell.Value
ActiveCell.Offset(0, -2).Select
On Error Resume Next
Sheets("Formato").Copy After:=Sheets(Sheets.Count)
Range("B15").Value = nombreHoja
Range("C15").Value = desConcepto
Range("H14").Value = uniConcepto
ActiveSheet.Name = nombreHoja
Sheets("Tabla").Select
ActiveCell.Offset(1, 0).Select
Wend
End Sub
Después de buscarle un buen rato llegue a esto que me funciona bastante bien, hace una copia del formato, les pega los datos de la tabla en las celdas que necesito, renombra la hoja, y se detiene cuando ya no hay más datos en la tabla.
¿Cómo ves esta macro? Se que tiene sus limitaciones, pero hasta ahora en mis pruebas he podido generar mis reportes sin mayor problema, pero espero tus comentarios para posibles mejoras, o para ver si podría haber algún problema.
Gracias, saludos.
Soy bastante nuevo en esto de las macros, así que mañana estudiare el código que pones, mientras, hoy estuve jugando con lo que tenia y logre una solución a lo que estaba buscando, este es mi código:
Sub GENERAR()
Sheets("Tabla").Select
Range("A2").Select
While ActiveCell <> ""
nombreHoja = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
desConcepto = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
uniConcepto = ActiveCell.Value
ActiveCell.Offset(0, -2).Select
On Error Resume Next
Sheets("Formato").Copy After:=Sheets(Sheets.Count)
Range("B15").Value = nombreHoja
Range("C15").Value = desConcepto
Range("H14").Value = uniConcepto
ActiveSheet.Name = nombreHoja
Sheets("Tabla").Select
ActiveCell.Offset(1, 0).Select
Wend
End Sub
Después de buscarle un buen rato llegue a esto que me funciona bastante bien, hace una copia del formato, les pega los datos de la tabla en las celdas que necesito, renombra la hoja, y se detiene cuando ya no hay más datos en la tabla.
¿Cómo ves esta macro? Se que tiene sus limitaciones, pero hasta ahora en mis pruebas he podido generar mis reportes sin mayor problema, pero espero tus comentarios para posibles mejoras, o para ver si podría haber algún problema.
Gracias, saludos.
Aunque veo que pones el nombre de la hoja y el concepto en la fila 15, supongo que será lo que buscas.
Lo que a mi no me gusta mucho es utilizar el 'Offset' para move la celda activa de una página, sino que prefiero hacer referencia con 'Cells'. El motivo es que si durante la ejecución alguien te cambia la celda activa (pulsando el ratón o cualquier tecla), la ejecución de la macro utilizando "Offset" se vería afectada pudiendo generar resultados erróneos.
Son cuestiones de gusto, nada más.
Ya me dirás si te funciona
Lo que a mi no me gusta mucho es utilizar el 'Offset' para move la celda activa de una página, sino que prefiero hacer referencia con 'Cells'. El motivo es que si durante la ejecución alguien te cambia la celda activa (pulsando el ratón o cualquier tecla), la ejecución de la macro utilizando "Offset" se vería afectada pudiendo generar resultados erróneos.
Son cuestiones de gusto, nada más.
Ya me dirás si te funciona
