No quería meterme ya que considero que 3pies tiene muy buenos consejos y controla bastante más que yo de excel, pero estaba interesado en el tema y he visto que no terminabais de dar con la solución. He probado lo que comenta 3pies y sino me equivoco tampoco será exactamente lo que niconico está buscando. Sin embargo, con alguna modificación estaría hecho. Bueno, para mi aplicación si
.
Dim Evita_copia As Boolean
Private Sub CheckBox1_Click()
Evita_copia = False
'Ocultamos el proceso, para que no se vean las operaciones
Application.ScreenUpdating = False
'Creamos la variable "posicion", que contendrá el rango actual donde estamos situados,
'es decir, si estamos en F16, la variable "posicion" contendrá esa celda
posicion = ActiveCell.Address
'Si el checkbox lo ponemos como true (ON), que haga lo siguiente
If CheckBox1.Value = True Then
'Seleccionamos el rango que queremos copiar
Range("B16:I16").Select
'Lo copiamos
Selection.Copy
'Seleccionamos el rango de destino de la copia
Range("B37:I37").Select
'Lo pegamos
ActiveSheet.Paste
'Desactivamos el área de selección de copia y pegado
Application.CutCopyMode = False
'Nos desplazamos a la celda de origen, es decir, allí donde
'estábamos inicialmente (por eso hemos guardado en "posicion", la celda)
Range(posicion).Select
'Si el checkbox está como false (OFF), que borre el contenido de B1 a B3
Else
Evita_copia = True
'Seleccionamos el rango que queremos borrar
Range("B37:I37").Select
'Borramos el contenido
Selection.ClearContents
'Nos desplazamos a la celda de origen, es decir, allí donde
'estábamos inicialmente (por eso hemos guardado en "posicion", la celda)
Range(posicion).Select
End If
'Mostramos el proceso
Application.ScreenUpdating = True
End Sub
Sub Worksheet_Change(ByVal Target As Range)
'Miramos si el rango de B6 a I16, cambia, para llamar al evento Click del CheckBox1
'(esto no es mío, ya que lo he sacado después de escarbar un poco en la red):
If Not Intersect(Target, Range("B16:I16")) Is Nothing
And Not Evita_copia Then
'Ocultamos el proceso, para que no se vean las operaciones
Application.ScreenUpdating = False
'Creamos la variable "posicion", que contendrá el rango actual donde estamos situados,
'es decir, si estamos en F16, la variable "posicion" contendrá esa celda
posicion = ActiveCell.Address
'Seleccionamos el rango que queremos copiar
Range("B16:I16").Select
'Lo copiamos
Selection.Copy
'Seleccionamos el rango de destino de la copia
Range("B37:I37").Select
'Lo pegamos
ActiveSheet.Paste
'Nos desplazamos a la celda de origen, es decir, allí donde
'estábamos inicialmente (por eso hemos guardado en "posicion", la celda)
Range(posicion).Select
'Desactivamos el área de selección de copia y pegado
Application.CutCopyMode = False
'Mostramos el proceso
Application.ScreenUpdating = True
End If
End Sub
he añadido lo que está en rojo al código de 3pies para evitar que cuando no esté el tic activo te ejecute la copia de los datos, que según he leido también te interesaba, ¿no?.
Espero que sea esto lo que necesitas.
Un saludo