Solução de problemas - Como espelhar duas células de diferentes planilhas no Excel (2013) usando o VBA

0

Estou trabalhando em uma configuração do VBA para um extenso arquivo de rastreamento de problemas. Eu tenho uma folha que contém todos os problemas e é difícil de gerenciar. Eu tenho outra planilha que é projetada para apresentar ao usuário os 10 itens de maior prioridade para um determinado dia, permitir que eles atualizem esses itens e recuperem mais problemas. Devido à maneira como os dados são espelhados, eu preciso que os usuários possam manipular os dados em qualquer uma das planilhas e fazer com que elas espelhem para a outra planilha.

Eu encontrei de outra questão algum código sugerido e consegui fazê-lo funcionar, desde que eu tenha apenas uma célula espelhada, mas assim que eu começo a duplicar o código para adicionar em outras células (existem cerca de 200 células precisa ser espelhado), todas as células param de atualizar (incluindo a que estava trabalhando anteriormente).

O outro problema que eu estava vendo antes mesmo de adicionar as linhas de código adicionais de espelhamento de células está relacionado a como a planilha reporta os dez itens de prioridade mais alta. Eu criei uma macro que leva a primeira folha (o difícil entender um) e classifica os dados de uma maneira específica e eu anexar essa macro a um botão na outra página. Quando pressiono o botão, ele ordena corretamente os dados na primeira planilha, mas a célula que foi espelhada nunca é atualizada. Então eu preciso saber 1) Como ajustar meu código para permitir que várias células sejam espelhadas, e 2) Como fazer isso quando eu classificar a primeira folha usando o botão, os dados são atualizados na segunda folha.

O código que estava funcionando quando eu tinha apenas um conjunto de células espelhadas era o seguinte, localizado no Código da Folha 1:

Private Sub Worksheet_Change_B2(ByVal Target As Range)

    Dim B2 As Range, B2_1 As Range
    Set B2 = Range("B2")
    Set B2_1 = Sheets("Priority Table").Range("B2")
    If Intersect(Target, B2) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        B2_1.Value = B2.Value
    Application.EnableEvents = True

End Sub

e os seguintes, localizados no código da planilha 2:

Private Sub Worksheet_Change_B2(ByVal Target As Range)

    Dim B2 As Range, B2_1 As Range
    Set B2 = Range("B2")
    Set B2_1 = Sheets("Issue List").Range("B2")
    If Intersect(Target, B2) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        B2_1.Value = B2.Value
    Application.EnableEvents = True

End Sub

O que eu tenho atualmente na planilha 1 é (estou incluindo três das células de referência em vez de todas as 200 +)

Private Sub Worksheet_Change_B2(ByVal Target As Range)

    Dim B2 As Range, B2_1 As Range
    Set B2 = Range("B2")
    Set B2_1 = Sheets("Priority Table").Range("B2")
    If Intersect(Target, B2) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        B2_1.Value = B2.Value
    Application.EnableEvents = True

End Sub    

Private Sub Worksheet_Change_I2(ByVal Target As Range)

    Dim I2 As Range, I2_1 As Range
    Set I2 = Range("I2")
    Set I2_1 = Sheets("Priority Table").Range("B3")
    If Intersect(Target, I2) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        I2_1.Value = I2.Value
    Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change_P2_1(ByVal Target As Range)

    Dim P2 As Range, P2_1 As Range
    Set P2 = Range("P2")
    Set P2_1 = Sheets("Priority Table").Range("B4")
    If Intersect(Target, P2) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        P2_1.Value = P2.Value
    Application.EnableEvents = True

End Sub

E na planilha 2, o código correspondente é:

Private Sub Worksheet_Change_B2(ByVal Target As Range)

    Dim B2 As Range, B2_1 As Range
    Set B2 = Range("B2")
    Set B2_1 = Sheets("Issue List").Range("B2")
    If Intersect(Target, B2) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        B2_1.Value = B2.Value
    Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change_B3(ByVal Target As Range)

    Dim B3 As Range, B3_1 As Range
    Set B3 = Range("B3")
    Set B3_1 = Sheets("Issue List").Range("I2")
    If Intersect(Target, B3) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        B3_1.Value = B3.Value
    Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change_B4(ByVal Target As Range)

    Dim B4 As Range, B4_1 As Range
    Set B4 = Range("B4")
    Set B4_1 = Sheets("Issue List").Range("P2")
    If Intersect(Target, B4) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        B4_1.Value = B4.Value
    Application.EnableEvents = True

End Sub

Qualquer ajuda para essas duas questões é muito apreciada !!!

Obrigado antecipadamente

    
por Mythranor 17.01.2017 / 02:56

0 respostas