Copiar rango de Excel a Access

Buen día, necesito de su ayuda,
tengo una rutina en macro esta esta ligada a access, al momento de que yo hago cualquier cambio en excel automáticamente se hace en access, mi problema es el siguiente,
si yo copio una celda y hago un rango se cambian todos en excel pero en access no solo la primera, las demás no ejemplo:
Escribo algo en "B3" y le doy Ctrl+C y selecciono de "B3:B8" > le doy enter y se cambian todas pero en access no solamente se cambia la que esta ligada a "B3"
Esto esta en la hoja "Hoja1"
Espero respuesta gracias
Esta es mi rutina.
Option Explicit
Dim EvitarRecursividad As Boolean
Private Sub UsarBaseDeDatos(Target As Excel.Range, Optional Accion As String = "EDITAR")
    Dim cnn As ADODB.Connection
    Dim dbMisDatos As Database
    Dim rsMisDatos As Recordset
    Dim ID2 As Long
    Dim Sql As String
     Accion = Format(Trim(Accion), ">")
     If Accion = "EDITAR" Then
        ID2 = Cells(Target.Row, 256).Value
        Set cnn = New ADODB.Connection
        cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & "Data Source=C:\Documents and Settings\jlmartin\Desktop\E&O CMX Nuevas Modificaciones\E&O Data base.mdb;"
        Set rsMisDatos = New ADODB.Recordset
        ID2 = Cells(Target.Row, 256).Value
        Sql = "select * from Base_ACCIONES where [E&O_ID]=" & ID2
        With rsMisDatos
            .CursorLocation = adUseClient
            .CursorType = adOpenKeyset
            .LockType = adLockOptimistic
            .Open Sql, cnn, , , adCmdText
        End With
        With rsMisDatos
            .Update
            rsMisDatos.Fields("ACTION DETAIL") = Cells(Target.Row, 88).Value
            rsMisDatos.Fields("E&O COMMENTS") = Cells(Target.Row, 92).Value
            .Update
        End With
    End If
    rsMisDatos.Close
    Set rsMisDatos = Nothing
    cnn.Close
    Set cnn = Nothing
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If EvitarRecursividad Then
        EvitarRecursividad = False
        Exit Sub
    End If
    If IsEmpty(Target.Value) Then
        If Not (IsEmpty(Cells(Target.Row, 88).Value) = True And IsEmpty(Cells(Target.Row, 92).Value) = True) Then
            If MsgBox("Sure you want to delete the record?", vbApplicationModal + vbDefaultButton2 + vbExclamation + vbOKCancel, "Advertencia...") = vbOK Then
                UsarBaseDeDatos Target, "ELIMINAR"
                Exit Sub
            Else
                EvitarRecursividad = True
               Application.Undo
            End If
        End If
        Exit Sub
    End If
    Select Case Target.Column
    Case 256
        MsgBox "You can not change the code"
        EvitarRecursividad = True
        Application.Undo
    Case 88, 92
        If IsEmpty(Cells(Target.Row, 256).Value) Then
            UsarBaseDeDatos Target, "INSERTAR"
        Else
            UsarBaseDeDatos Target, "EDITAR"
        End If
    Case Else
        MsgBox "You can not change"
        EvitarRecursividad = True
        Application.Undo
    End Select
End Sub