VBA werkt niet

Ik heb de VBA gekopieerd voor het kopiëren van gegevens van een cel naar dezelfde rij in een andere kolom en deze gewijzigd zodat ik een cel in kolom F kan wijzigen en de waarde in kolom E kan opslaan, maar als ik het probeer, gebeurt er niets. Kan iemand mij vertellen wat ik fout doe? Ik wil ook een datumstempel in kolom G plaatsen als ik de wijziging aanbreng.

Ik hoopte hetzelfde te kunnen doen wanneer ik een cel in kolom I wijzig om deze op te slaan in kolom H en die wijziging in kolom J van een datumstempel te voorzien.

Alle hulp zou zeer gewaardeerd worden.


Dim xRg als bereik
Dim xChangeRg als bereik
Dim xDependRg als bereik
Dim xDic als nieuw woordenboek
Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
Dim ik zo lang
Dim xCell als bereik
Dim xDCell als bereik
Dim xHeader als tekenreeks
Dim xCommText als tekenreeks
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Vorige waarde :"
x = xDic.Toetsen
Voor I = 0 Naar UBound(xDic.Keys)
Set xCell = Bereik(xDic.Keys(I))
Stel xDCell = Cellen in (xCell.Rij, 5)
xDCell.Waarde = ""
xDCell.Waarde = xDic.Items(I)
Volgende
Application.EnableEvents = Waar
Application.ScreenUpdating = True
End Sub
Privé subwerkblad_SelectionChange (ByVal-doel als bereik)
Dim I, J zo lang
Dim xRgArea als bereik
Bij fout Ga naar Label1
Als Target.Count > 1 Sub afsluiten
Application.EnableEvents = False
Stel xDependRg = Target.Dependents in
Als xDependRg niets is, ga dan naar Label1
Zo niet, dan is xDependRg niets
Set xDependRg = Intersect(xDependRg, Range("F:F"))
End If
Etiket1:
Set xRg = Intersect(Doel, Bereik("F:F"))
Als (Niet xRg Is Niets) En (Niet xDependRg Is Niets) Dan
Stel xChangeRg = Union(xRg, xDependRg) in
ElseIf (xRg is niets) en (niet xDependRg is niets) Dan
Stel xChangeRg = xDependRg in
ElseIf (Niet xRg Is Niets) En (xDependRg Is Niets) Dan
Stel xChangeRg = xRg in
Anders
Application.EnableEvents = Waar
Exit Sub
End If
xDic.Alles verwijderen
Voor I = 1 tot xChangeRg.Areas.Count
Stel xRgArea = xChangeRg.Areas(I) in
Voor J = 1 tot xRgArea.Count
xDic.Voeg xRgArea(J).Address, xRgArea(J).Formule toe
Volgende
Volgende
Stel xChangeRg = niets in
Stel xRg = Niets in
Stel xDependRg = niets in
Application.EnableEvents = Waar
End Sub