donde está el error?

[niconico]

Tengo este código:

Código:

Dim Evita_copia As Boolean

Private Sub CheckBox1_Click()
Evita_copia = False
Application.ScreenUpdating = False
posicion = ActiveCell.Address
If CheckBox1.Value = True Then
Range("B17:I17").Select
Selection.Copy
Range("B38:I38").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range(posicion).Select
Else
Evita_copia = True
Range("B38:I38").Select
Selection.ClearContents
Range(posicion).Select
End If
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox2_Click()
Evita_copia = False
Application.ScreenUpdating = False
posicion = ActiveCell.Address
If CheckBox2.Value = True Then
Range("B16:I16").Select
Selection.Copy
Range("B37:I37").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range(posicion).Select
Else
Evita_copia = True
Range("B37:I37").Select
Selection.ClearContents
Range(posicion).Select
End If
Application.ScreenUpdating = True
End Sub

Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B17:I17")) Is Nothing And Not Evita_copia Then
Application.ScreenUpdating = False
posicion = ActiveCell.Address
Range("B17:I17").Select
Selection.Copy
Range("B38:I38").Select
ActiveSheet.Paste
Range(posicion).Select
Application.CutCopyMode = False
End If

If Not Intersect(Target, Range("B16:I16")) Is Nothing And Not Evita_copia Then
Application.ScreenUpdating = False
posicion = ActiveCell.Address
Range("B16:I16").Select
Selection.Copy
Range("B37:I37").Select
ActiveSheet.Paste
Range(posicion).Select
Application.CutCopyMode = False


Application.ScreenUpdating = True
End If
End Sub

En este código (que no es mío yo simplemente lo he adaptado a mis necesidades) hay dos checkbox y cada uno de ellos copia el contenido de unas celdas en otras, modifcandose automáticamente las celdas de destino si se modifican las celdas de origen. El problema es que falla este código por ejemplo en el caso de que un checkbox esté activado y otro no, si se borran más de una celda sólo te borra el contenido de una celda no el de todas aquellas celdas que has seleccionado. Los errores los noto cuando borro a más de una celda a la vez. Pero no se cual puede ser el error, muchas gracias

[niconico]

He dado con la solución, he hecho dos modificaciones: declarar las variables dentro de cada procedimiento y añadir un checkbox1.value=true.
El código:

Código:

Private Sub CheckBox1_Click()
Dim Evita_copia As Boolean
Evita_copia = False
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("B17:I17").Select
'Lo copiamos
Selection.Copy
'Seleccionamos el rango de destino de la copia
Range("B38:I38").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("B38:I38").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
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox2_Click()
Dim Evita_copia As Boolean
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 CheckBox2.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)
Dim Evita_copia As Boolean
Application.ScreenUpdating = False

'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("B17:I17")) Is Nothing And Not Evita_copia And CheckBox1.Value = True Then
'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("B17:I17").Select
'Lo copiamos
Selection.Copy
'Seleccionamos el rango de destino de la copia
Range("B38:I38").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
End If


If Not Intersect(Target, Range("B16:I16")) Is Nothing And Not Evita_copia And CheckBox2.Value = True Then
'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
End If
'Mostramos el proceso
Application.ScreenUpdating = True

End Sub