Macro para copiar celdas
Necesito una macro que me copie los datos de la celda B5 de la hoja 1 a la celda A2 de la hoja 2 lo que pasa es que los datos de la celda B5 me van cambiando y quiero que todos los datos se me vallan guardando en la celda A2, A3, A4, ... En fin en toda la columna de la hoja2 como para llevar un historial. Ya tengo un programa el problema es que el me copia solo un dato de la celda B5 y me lo pasa a la columna E de la misma hoja también hay otro problema y es que el solo me copia un dato de la celda B5 y se me cambia a la B6 necesito que se me quede tomando los datos de la celda B5. Este es el programa
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngLibre As Long
Dim UltimaFila As Long
UltimaFila = Range("E65536").End(xlUp).Row
datos = "B5"
If Not Application.Intersect(Target, Range(datos)) Is Nothing Then
'mostramos un mensaje
UltimaFila = UltimaFila + 1
Cells(UltimaFila, 5).Value = Cells(5, 2).Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngLibre As Long
Dim UltimaFila As Long
UltimaFila = Range("E65536").End(xlUp).Row
datos = "B5"
If Not Application.Intersect(Target, Range(datos)) Is Nothing Then
'mostramos un mensaje
UltimaFila = UltimaFila + 1
Cells(UltimaFila, 5).Value = Cells(5, 2).Value
End If
End Sub
1 Respuesta
Respuesta de santiagomf
1
Prueba con este código en la 'Hoja1'. Creo que es lo que quieres hacer.
Un saludo
Option Explicit
Dim snCambioB5 As Boolean
Private Sub Worksheet_Activate()
snCambioB5 = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
snCambioB5 = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Copiamos el valor en la hoja 2
If snCambioB5 Then copiaValorB5enHoja2 Cells(5, 2): snCambioB5 = False
' Para que no se mueva de la celda B5 de la Hoja1
Sheets("Hoja1").Select
Cells(5, 2).Select
End Sub
Private Sub copiaValorB5enHoja2(ByVal valorB5)
Dim nLin As Long
If IsNull(valorB5) Or valorB5 = "" Then Exit Sub
' Buscaremos de forma rápida la última línea grabada
' Primero de 1000 en 1000 hasta que no haya nada
nLin = 2
Do While Sheets("Hoja2").Cells(nLin, 2) <> ""
nLin = nLin + 1000
Loop
' Volvemos hacia atras de 25 en 25 hasta que haya una ocupada
Do While Sheets("Hoja2").Cells(nLin, 2) = ""
If nLin > 25 Then nLin = nLin - 25 Else Exit Do
Loop
' Y buscamos de 1 en 1 hacia delante hasta que haya una libre
Do While Sheets("Hoja2").Cells(nLin, 2) <> ""
nLin = nLin + 1
Loop
' nLin contiene el primer número de línea vacío. Guardamos el valor ahí
Sheets("Hoja2").Cells(nLin, 2) = valorB5
End Sub
Un saludo
Option Explicit
Dim snCambioB5 As Boolean
Private Sub Worksheet_Activate()
snCambioB5 = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
snCambioB5 = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Copiamos el valor en la hoja 2
If snCambioB5 Then copiaValorB5enHoja2 Cells(5, 2): snCambioB5 = False
' Para que no se mueva de la celda B5 de la Hoja1
Sheets("Hoja1").Select
Cells(5, 2).Select
End Sub
Private Sub copiaValorB5enHoja2(ByVal valorB5)
Dim nLin As Long
If IsNull(valorB5) Or valorB5 = "" Then Exit Sub
' Buscaremos de forma rápida la última línea grabada
' Primero de 1000 en 1000 hasta que no haya nada
nLin = 2
Do While Sheets("Hoja2").Cells(nLin, 2) <> ""
nLin = nLin + 1000
Loop
' Volvemos hacia atras de 25 en 25 hasta que haya una ocupada
Do While Sheets("Hoja2").Cells(nLin, 2) = ""
If nLin > 25 Then nLin = nLin - 25 Else Exit Do
Loop
' Y buscamos de 1 en 1 hacia delante hasta que haya una libre
Do While Sheets("Hoja2").Cells(nLin, 2) <> ""
nLin = nLin + 1
Loop
' nLin contiene el primer número de línea vacío. Guardamos el valor ahí
Sheets("Hoja2").Cells(nLin, 2) = valorB5
End Sub
Muchísimas gracias por el programa era justo lo que necesitaba me gustaría saber si hay alguna posibilidad que en este mismo programa cada ves que se pasa un dato de la hoja 1 a la hoja 2 se le pudiera meter en una columna con la hora y la fecha en la que se recibe cada dato y que se valla llenando paralelamente con los otros datos pero en una columna diferente de la hoja 2. gracias .
Podrías poner en la columna "C" de la hoja 2 la fecha y hora.
Detrás de la línea 'Sheets("Hoja2"). Cells(nLin, 2) = valorB5', tendrías que poner:
Sheets("Hoja2").Cells(nlin, 3) = Now()
Sheets("Hoja2"). Cells(nlin, 3).NumberFormat = "dd-mm-yyyy hh:mm:ss"
La primera línea asigna la fecha/hora actual y la segunda da formato a la celda.
No olvides ensanchar la columna "C" para que se vea bien el contenido.
Detrás de la línea 'Sheets("Hoja2"). Cells(nLin, 2) = valorB5', tendrías que poner:
Sheets("Hoja2").Cells(nlin, 3) = Now()
Sheets("Hoja2"). Cells(nlin, 3).NumberFormat = "dd-mm-yyyy hh:mm:ss"
La primera línea asigna la fecha/hora actual y la segunda da formato a la celda.
No olvides ensanchar la columna "C" para que se vea bien el contenido.
Amigo muchas gracias creo que es justo lo que necesito pero no entiendo muy bn donde debo poner el código gracias. Es no no soy nada experto en el tema le agradecería que me diera indicaciones como. Gracias
Amigo gracias usted es un duro para esto lo felicito me gustaría tener su correo pues para próximas ayudas el mio es [email protected] ya ya pude resolver el problemita de lo de la hora y fecha.
