VBA tidak berfungsi

Saya telah menyalin VBA untuk menyalin data dari sel ke baris yang sama kolom yang berbeda dan mengubahnya sehingga saya dapat mengubah sel di Kolom F dan menyimpan nilainya ke kolom E, tetapi ketika saya mencobanya tidak terjadi apa-apa. Bisakah seseorang memberi tahu saya apa yang saya lakukan salah? Saya juga ingin menempatkan stempel tanggal di kolom G saat saya melakukan perubahan.

Saya berharap juga dapat melakukan hal yang sama ketika saya mengubah sel di Kolom I untuk menyimpannya ke Kolom H dan stempel tanggal yang berubah di Kolom J.

Bantuan apa pun akan sangat dihargai.


Redupkan xRg Sebagai Rentang
Redupkan xChangeRg Sebagai Jangkauan
Redupkan xDependRg Sebagai Rentang
Dim xDic Sebagai Kamus Baru
Sub Lembar Kerja Pribadi_Rubah (Rentang Target As ByVal)
Redup Aku Selamanya
Redupkan xCell Sebagai Rentang
Redupkan xDCell Sebagai Kisaran
Dim xHeader Sebagai String
Redupkan xCommText Sebagai String
On Error Resume Next
Application.ScreenUpdating = Salah
Application.EnableEvents = Salah
xHeader = "Nilai sebelumnya :"
x = xDic.Kunci
Untuk I = 0 Ke UBound(xDic.Keys)
Atur xCell = Range(xDic.Keys(I))
Atur xDCell = Sel(xCell.Row, 5)
xDCell.Nilai = ""
xDCell.Nilai = xDic.Items(I)
Selanjutnya
Application.EnableEvents = Benar
Application.ScreenUpdating = Benar
End Sub
Sub Worksheet_SelectionChange Pribadi (Target ByVal Sebagai Rentang)
Redupkan I, J Selama
Redupkan xRgArea Sebagai Kisaran
Saat Error GoTo Label1
Jika Target.Count > 1 Kemudian Keluar Sub
Application.EnableEvents = Salah
Tetapkan xDependRg = Target.Dependents
Jika xDependRg Bukan Apa-apa Lalu Buka Label1
Jika Tidak xDependRg Bukan Apa-apa Lalu
Tetapkan xDependRg = Intersect(xDependRg, Range("F:F"))
End If
Label1:
Atur xRg = Intersect(Target, Range("F:F"))
Jika (Bukan xRg Bukan Apa-apa) Dan (Bukan xDependRg Bukan Apa-apa) Lalu
Tetapkan xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Bukan Apa-apa) Dan (Bukan xDependRg Bukan Apa-apa) Lalu
Tetapkan xChangeRg = xDependRg
ElseIf (Bukan xRg Bukan Apa-apa) Dan (xDependRg Bukan Apa-apa) Lalu
Tetapkan xChangeRg = xRg
Lain
Application.EnableEvents = Benar
Keluar dari Sub
End If
xDic.Hapus Semua
Untuk I = 1 Ke xChangeRg.Areas.Count
Tetapkan xRgArea = xChangeRg.Area(I)
Untuk J = 1 Ke xRgArea.Count
xDic.Tambahkan xRgArea(J).Address, xRgArea(J).Formula
Selanjutnya
Selanjutnya
Atur xChangeRg = Tidak ada
Tetapkan xRg = Tidak ada
Atur xDependRg = Tidak ada
Application.EnableEvents = Benar
End Sub