Copiar datos de diferentes celdas y pegarlas en una tabla
Espero me puedan ayudar, tengo una hoja en excel la cual tiene datos en diferentes celdas y columnas, ocupo copiar esos valores y pegarlos en otra hoja en cierto orden en una tabla.
Esta es la hoja en cuestión
Ocupo copiar los datos en rojo que están mostrados por formulas y pegarlos en fila en la siguiente tabla y en ese orden 1,2,3,4,5,6,7 hacia la derecha
A la vez que este macro sea por botón y que cada vez que se presione copie y pegue esa información en una nueva fila y se valla creando una lista hacia abajo, supongo que el macro debe detectar si la fila esta vacía o no.
He intentado hacerlo yo mismo pero mi conocimiento no me dió para tanto, realmente aprecio toda la ayuda posible, ahí se observa el botón de pasar datos, pero no funciona, esto es por cuestiones de trabajo.
2 Respuestas
Lo he hecho a línea de vista pero ahí va.
Sub PasarDatos()
Application.ScreenUpdating = False ' Con esta rutina ocultamos la ejecución del proceso vale decir el pasar de una hoja a otra
'Declaramos nuestras variables
vacio = False
Set h2 = Sheets("Hoja2")
' Te lo dejo para 2000 registros
For i = 1 To 2000
'Preguntamos si fila de hoja2 esta vacía
If h2.Cells(i, "A") = "" Then
vacio = True
Exit For
End If
Next i
Pasamos datos a hoja2
If vacio Then
h2.Cells(i, "A") = h2.Range("D2")
h2.Cells(i, "B") = h2.Range("D1")
h2.Cells(i, "C") = h2.Range("D11")
h2.Cells(i, "D") = h2.Range("D13")
h2.Cells(i, "E") = h2.Range("H11")
h2.Cells(i, "F") = h2.Range("H12")
h2.Cells(i, "G") = h2.Range("H13")
'Agrego un mensaje para que sepas que se guardó registro
Else
MsgBox "Usted procedió a registrar", vbInformation, "Mi Mensaje"
End If
Application.ScreenUpdating = True
'Regresamos a hoja1 celda D1
Sheets("Hoja1").range("D1")
End Sub
Consideraciones:
1. Antes que todo, guarda una copia de tu proyecto .
2. Pega la rutina en tu botón.
3. Ejecutar.
4. Si sale error capturas pantallas y las envías.
Alberto gracias por tomar mi caso, no soy muy diestro con lo macros, pero me da este error, estaré haciendo algo mal, lo pegue bien, la hoja donde se copian los datos se llama RESUMEN y donde se pegan se llama REGISTRO, muchas gracias por tu tiempo
Sorry al final de la línea de error (resaltado en amarillo) agrégale
Sheets("RESUMEN").Range("D1").select
Me comentas
Hola de nuevo, ya no me lanza ningún error, pero no copia nada, tampoco lanza el mensaje de confirmación que agregaste, sabes que puede ser, en la imagen verás la tabla antes y después de pulsar el botón
Adjunto de nuevo el código cómo está, a modo de información
Hola de nuevo, acabo de revisar bien el código que me diste y note el problema, en la parte donde están las celdas que se ocupan copiar, la hoja estaba mal definida, seguía estando en la página dos, también las celdas no coincidían bien, muestro el código correcto, quité el else porque no mostraba el mensaje, ahora si lo muestra, realicé varias pruebas y todo funciona correctamente, todo se copia y se pega cómo tiene que ser.
Ah ok por eso coloque al inicio : "Lo he hecho a línea de vista pero ahí va." porque miraba tu cuadro y lo estaba plasmando directo... es bueno que intentes buscar las soluciones ... EXCELENTE!
Todo bien entonces.
Sub quiebres()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim Ho As Worksheet: Set Ho = wb.Sheets("Resumen")
Dim Hd As Worksheet: Set Hd = wb.Sheets("Registro")
Dim ucel
'ucel = Hd.Range("A" & Rows.Count).End(xlUp).Row + 1
'For i = 2 To Ho.Range("A" & Rows.Count).End(xlUp).Row
'For i = 1 To Ho.Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
ucel = Hd.Cells(Hd.Rows.Count, 1).End(xlUp).Row + 1
If Ho.Cells(4, "d") > 0 Then
Ho.Cells(2, "d"). Copy Hd. Cells(ucel, "A")
Ho.Cells(1, "d"). Copy Hd. Cells(ucel, "b")
Ho. Cells(10, "d"). Copy Hd. Cells(ucel, "c")
Ho. Cells(11, "d"). Copy Hd. Cells(ucel, "d")
Ho. Cells(10, "h"). Copy Hd. Cells(ucel, "e")
Ho. Cells(12, "h"). Copy Hd. Cells(ucel, "f")
Ho. Cells(13, "h"). Copy Hd. Cells(ucel, "g")
'Ho.Cells(i, "C"). Copy Hd. Cells(ucel, "C")
Application.CutCopyMode = False
End If
Sheets("RESUMEN").Range("D1").Select
Application.ScreenUpdating = False
End Sub