Copiei o VBA para copiar dados da célula para a mesma linha, coluna diferente e alterei-o para poder alterar uma célula na coluna F e salvar o valor na coluna E, mas quando tento, nada acontece. Alguém pode me dizer o que estou fazendo de errado? Também gostaria de colocar um carimbo de data na coluna G quando fizer a alteração.

Eu também esperava poder fazer a mesma coisa quando altero uma célula na Coluna I para salvá-la na Coluna H e marcar a data dessa alteração na Coluna J.

Qualquer ajuda seria muito apreciada.


Dim xRg como intervalo
Dim xChangeRg como intervalo
Dim xDependRg como intervalo
Dim xDic como novo dicionário
Private Sub Worksheet_Change (ByVal Target As Range)
Escurecer eu enquanto
Dim xCell como intervalo
Dim xDCell como intervalo
Dim xHeader como String
Dim xCommText como string
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Valor anterior:"
x = xDic.Keys
Para I = 0 Para UBound(xDic.Keys)
Definir xCell = Range(xDic.Keys(I))
Definir xDCell = Cells(xCell.Row, 5)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Próximo
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub Worksheet_SelectionChange particular (destino ByVal como intervalo)
Dim I, J Enquanto
Dim xRgArea como intervalo
Em caso de erro Ir para Label1
Se Target.Count > 1, então Exit Sub
Application.EnableEvents = False
Definir xDependRg = Target.Dependents
Se xDependRg não for nada, vá para Label1
Se não, xDependRg não é nada, então
Set xDependRg = Intersect(xDependRg, Range("F:F"))
Se acabar
Marca1:
Set xRg = Intersect(Target, Range("F:F"))
Se (não xRg é nada) e (não xDependRg não é nada) então
Defina xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg é nada) e (não xDependRg é nada) Então
Defina xChangeRg = xDependRg
ElseIf (não xRg é nada) e (xDependRg não é nada) então
Definir xChangeRg = xRg
Outro
Application.EnableEvents = True
Exit Sub
Se acabar
xDic.RemoveAll
Para I = 1 To xChangeRg.Areas.Count
Defina xRgArea = xChangeRg.Areas(I)
Para J = 1 To xRgArea.Count
xDic.Adicionar xRgArea(J).Endereço, xRgArea(J).Fórmula
Próximo
Próximo
Definir xChangeRg = Nada
Definir xRg = Nada
Definir xDependRg = Nada
Application.EnableEvents = True
End Sub