Espelhe as células quando uma alteração em uma das células atualiza a outra

0

Gary's Student respondeu a essa pergunta antes e funcionou muito bem para apenas 1 célula por folha. Se eu quisesse espelhar múltiplas células, o que eu poderia fazer? Eu tentei o seguinte e não funciona. Eu não recebo erros, mas nada acontece. Eu sou novo no VBA BTW.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r1 As Range, r2 As Range
Set r1 = Range("C3:D3")
Set r2 = Sheets("Flight Planning").Range("K1:K2")
If Intersect(Target, r1) Is Nothing Then Exit Sub
Application.EnableEvents = False
    r2.Value = r1.Value
Application.EnableEvents = True

Dim r3 As Range, r4 As Range
Set r3 = Range("E22")
Set r4 = Sheets("Flight Planning").Range("B4")
If Intersect(Target, r3) Is Nothing Then Exit Sub
Application.EnableEvents = False
    r4.Value = r3.Value
Application.EnableEvents = True

Dim r5 As Range, r6 As Range
Set r5 = Range("E24")
Set r6 = Sheets("Flight Planning").Range("C4:D4")
If Intersect(Target, r5) Is Nothing Then Exit Sub
Application.EnableEvents = False
    r6.Value = r5.Value
Application.EnableEvents = True
End Sub

Obrigado

    
por Phenom300driver 28.06.2016 / 04:36

1 resposta

0

Eu lhe dei alguns comentários para refletir. Mas eu ofereço a você esta solução, temporário , para que você possa ver uma possível correção. Por favor, deixe-me saber se isso ajuda sua lógica.

Se a solução temporária que apresento abaixo resolver o que você está trabalhando, por favor, marque a caixa como solução aceita, para que fique sabendo que ela está encerrada.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r1 As Range, r2 As Range
Set r1 = Range("C3:D3")
Set r2 = Sheets("Flight Planning").Range("K1:K2")
If Intersect(Target, r1) Is Nothing Then Exit Sub
  MsgBox "(1) Nothing" 'Let me know
Else
  Application.EnableEvents = False
    r2.Value = r1.Value
  Application.EnableEvents = True
EndIf

Dim r3 As Range, r4 As Range
Set r3 = Range("E22")
Set r4 = Sheets("Flight Planning").Range("B4")
If Intersect(Target, r3) Is Nothing Then Exit Sub
  MsgBox "(2) Nothing" 'Let me know
Else
  Application.EnableEvents = False
      r4.Value = r3.Value
  Application.EnableEvents = True
EndIf

Dim r5 As Range, r6 As Range
Set r5 = Range("E24")
Set r6 = Sheets("Flight Planning").Range("C4:D4")
If Intersect(Target, r5) Is Nothing Then Exit Sub
  MsgBox "(3) Nothing" 'Let me know or leave line blank
Else
  Application.EnableEvents = False
      r6.Value = r5.Value
  Application.EnableEvents = True
EndIf


End Sub

Um único "'" está fazendo um comentário, que comenta o restante da linha à direita e é ignorado. Ele deve ficar verde no ambiente do Excel. Você pode comentar o Msgbox completamente com uma simples citação.

    
por 28.06.2016 / 07:34