VBA no funciona

Copié el VBA para copiar datos de la celda en la misma fila y columna diferente y lo cambié para poder cambiar una celda en la columna F y guardar el valor en la columna E, pero cuando lo intento no sucede nada. ¿Alguien puede decirme qué estoy haciendo mal? También me gustaría colocar una marca de fecha en la columna G cuando realice el cambio.

Esperaba poder hacer lo mismo cuando cambio una celda en la Columna I para guardarla en la Columna H y marcar la fecha de ese cambio en la Columna J.

Cualquier ayuda sería muy apreciada.


Dim xRg como rango
Dim xChangeRg como rango
Dim xDependRg como rango
Dim xDic como nuevo diccionario
Sub hoja de trabajo privada_Cambio (según el rango de destino ByVal)
Dim I tan largo
Dim xCell como rango
Dim xDCell como rango
Dim xHeader como cadena
Dim xCommText como cadena
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Valor anterior:"
x = xDic.Teclas
Para I = 0 a UBound(xDic.Keys)
Establecer xCell = Rango (xDic.Keys (I))
Establecer xDCell = Cells(xCell.Row, 5)
xDCell.Valor = ""
xDCell.Value = xDic.Items(I)
NEXT
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub hoja de trabajo privada_Cambio de selección (rango de destino ByVal)
Dim I, J como siempre
Dim xRgArea como rango
En caso de error Ir a etiqueta1
Si Target.Count > 1, entonces salga de Sub
Application.EnableEvents = False
Establezca xDependRg = Target.Dependents
Si xDependRg no es nada, vaya a Label1
Si no xDependRg no es nada, entonces
Establecer xDependRg = Intersect(xDependRg, Range("F:F"))
Si terminar
Etiqueta1:
Establecer xRg = Intersecar(Objetivo, Rango("F:F"))
Si (No xRg no es nada) y (No xDependRg no es nada) Entonces
Establecer xChangeRg = Unión (xRg, xDependRg)
De lo contrario, si (xRg no es nada) y (no xDependRg no es nada), entonces
Establecer xChangeRg = xDependRg
ElseIf (No xRg no es nada) y (xDependRg no es nada) Entonces
Establecer xChangeRg = xRg
otro
Application.EnableEvents = True
Exit Sub
Si terminar
xDic.RemoveAll
Para I = 1 Para xChangeRg.Areas.Count
Establecer xRgArea = xChangeRg.Areas(I)
Para J = 1 Para xRgArea.Count
xDic.Add xRgArea(J).Dirección, xRgArea(J).Fórmula
NEXT
NEXT
Establecer xChangeRg = Nada
Establecer xRg = Nada
Establecer xDependRg = Nada
Application.EnableEvents = True
End Sub