Copiar Celdas especificas Excel en otra hoja
La respuesta tomada del historial de preguntas (Titulo: "Macro para copiar celdas") me ha servido como parte de la solución a la inquietud que tengo (Aclaro que soy novato en Visual Basic).
De acuerdo a la siguiente macro que traslada automáticamente el contenido cambiante de la celda D6 de la Hoja "Factura" a la columna A de la "Hoja1" en el orden sucesivo de las filas (A1, A2, A3...), permitanme por favor las siguientes preguntas:
1. Cuando se abre la hoja "factura" se queda "tildado" el cursor en la Casilla D6, y no deja colocar ninguna información en las demas celdas de la hoja "Factura". Sin embargo, cada vez que se introduce un dato en D6 las copia automáticamente en "Hoja1" de manera correcta.
2. ¿Qué lineas inserto en la macro para que también lleve a la "Hoja1", por ejemplo, a la columna B, el contenido de la casilla D7 de "Factura"?.
3. Antes de imprimir el recibo o la factura, puede variar el contenido de las casilla D6 o D7, y la macro actualiza de inmediato el traslado de la información a la "Hoja1" cada vez que se digita nuevo contenido, ¿qué lineas inserto para que copie los datos en "Hoja1" solamente cuando se imprima el recibo y no antes?.
Option Explicit
Dim snCambioD6 As Boolean
Private Sub Worksheet_Activate()
snCambioD6 = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
snCambioD6 = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Copiamos el valor en la hoja 1
If snCambioD6 Then copiaValorD6enHoja1 Cells(6, 4): snCambioD6 = False
' Para que no se mueva de la celda D6 de la Hoja1
Sheets("Factura").Select
Cells(6, 4).Select
End Sub
Private Sub copiaValorD6enHoja1(ByVal valorD6)
Dim nLin As Long
If IsNull(valorD6) Or valorD6 = "" Then Exit Sub
' Buscaremos de forma rápida la última línea grabada
' Primero de 1000 en 1000 hasta que no haya nada
nLin = 1
Do While Sheets("Hoja1").Cells(nLin, 1) <> ""
nLin = nLin + 1000
Loop
' Volvemos hacia atras de 25 en 25 hasta que haya una ocupada
Do While Sheets("Hoja1").Cells(nLin, 1) = ""
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("Hoja1").Cells(nLin, 1) <> ""
nLin = nLin + 1
Loop
' nLin contiene el primer número de línea vacío. Guardamos el valor ahí
Sheets("Hoja1").Cells(nLin, 4) = Now()
Sheets("Hoja1").Cells(nLin, 4).NumberFormat = "dd-mm-yyyy hh:mm:ss"
Worksheets("Hoja1").Cells(nLin, 1) = valorD6
End Sub