VBA non funziona

Ho copiato il VBA per copiare i dati dalla cella nella stessa riga di una colonna diversa e l'ho modificato in modo da poter cambiare una cella nella colonna F e salvare il valore nella colonna E, ma quando provo non succede nulla. Qualcuno può dirmi cosa sto facendo male? Vorrei anche inserire un datestamp nella colonna G quando effettuo la modifica.

Speravo di poter fare la stessa cosa anche quando cambio una cella nella colonna I per salvarla nella colonna H e datare la modifica nella colonna J.

Qualsiasi aiuto sarebbe molto apprezzato.


Dim xRg come intervallo
Dim xChangeRg come intervallo
Dim xDependRg come intervallo
Dim xDic come nuovo dizionario
Private Sub Worksheet_Change (ByVal Target As Range)
Dim I quanto a lungo
Dim xCell come intervallo
Dim xDCell come intervallo
Dim xHeader come stringa
Dim xCommText come stringa
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Valore precedente:"
x = xDic.Tasti
Per I = 0 A UBound(xDic.Keys)
Imposta xCell = Range(xDic.Keys(I))
Imposta xDCell = Celle(xCell.Row, 5)
xDCell.Value = ""
xDCella.Valore = xDic.Articoli(I)
Avanti
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim I, J tanto a lungo
Dim xRgArea come intervallo
In caso di errore GoTo Label1
Se Target.Count > 1 Quindi esci da Sub
Application.EnableEvents = False
Impostare xDependRg = Target.Dependents
Se xDependRg non è niente, vai a Label1
Se non xDependRg non è niente, allora
Imposta xDependRg = Intersect(xDependRg, Range("F:F"))
End If
Etichetta1:
Imposta xRg = Interseca(Obiettivo, Intervallo("F:F"))
If (Not xRg Is Nothing) E (Not xDependRg Is Nothing) Then
Imposta xChangeRg = Union(xRg, xDependRg)
AltrimentiSe (xRg non è niente) E (Non xDependRg non è niente) Allora
Impostare xChangeRg = xDependRg
ElseIf (Not xRg non è niente) E (xDependRg non è niente) Allora
Impostare xCambiaRg = xRg
Altro
Application.EnableEvents = True
Exit Sub
End If
xDic.RimuoviTutto
Per I = 1 A xChangeRg.Areas.Count
Imposta xRgArea = xCambiaRg.Areas(I)
Per J = 1 A xRgArea.Count
xDic.Add xRgArea(J).Indirizzo, xRgArea(J).Formula
Avanti
Avanti
Impostare xChangeRg = Niente
Imposta xRg = Niente
Impostare xDependRg = Niente
Application.EnableEvents = True
End Sub