Como sincronizar listas suspensas em várias planilhas no Excel?

Suponha que você tenha listas suspensas em várias planilhas em uma pasta de trabalho que contenham exatamente os mesmos itens suspensos. Agora você deseja sincronizar as listas suspensas nas planilhas para que, depois de selecionar um item de uma lista suspensa em uma planilha, as listas suspensas em outras planilhas sejam automaticamente sincronizadas com a mesma seleção. Este artigo fornece um código VBA para ajudá-lo a resolver esse problema.

Sincronize listas suspensas em várias planilhas com código VBA

Sincronize listas suspensas em várias planilhas com código VBA

Por exemplo, as listas suspensas estão em cinco planilhas denominadas Folha1, Folha2, ..., Folha 5, para sincronizar as listas suspensas em outras planilhas de acordo com a seleção suspensa em Sheet1, aplique o seguinte código VBA para fazer isso.

1. Abra a Plan1, clique com o botão direito do mouse na guia da planilha e selecione Ver código no menu do botão direito do mouse.

2. No Microsoft Visual Basic para Aplicações janela, cole o seguinte código VBA no Planilha1 (Código) janela.

Código VBA: Sincronizar lista suspensa em várias planilhas

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220815
    Dim tSheet1 As Worksheet
    Dim tRange As Range
    Dim xRangeStr As String
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    
    xRangeStr = "A2:A11"

    Set tRange = Intersect(Target, Range(xRangeStr))
    If Not tRange Is Nothing Then
        xRangeStr = tRange.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet2")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet3")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet4")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet5")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Application.EnableEvents = True
    End If
    
End Sub

notas:

1) No código, A2: A11 é o intervalo que contém a lista suspensa. Certifique-se de que todas as listas suspensas estejam no mesmo intervalo em diferentes planilhas.

2) Folha2, Folha3, Folha4 e Sheet5 são planilhas que contêm listas suspensas que você deseja sincronizar com base na lista suspensa em Plan1;

3) Para adicionar mais planilhas no código, adicione as duas linhas a seguir antes da linha “Application.EnableEvents = True”, em seguida, altere o nome da planilha “Sheet5” para o nome que você precisa.

Set tSheet1 = ActiveWorkbook.Worksheets("Sheet5")

tSheet1.Range(xRangeStr).Value = Target.Value

3. aperte o outro + Q chaves para fechar o Microsoft Visual Basic para Aplicações janela.

A partir de agora, quando você selecionar um item da lista suspensa em Folha 1, as listas suspensas nas planilhas especificadas serão sincronizadas automaticamente para ter a mesma seleção. Veja a demonstração abaixo.

Demonstração: Sincronize listas suspensas em várias planilhas no Excel

As melhores ferramentas de produtividade para escritório

O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%

armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
Barra Super Fórmula (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2021 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Recursos completos de avaliação gratuita de 30 dias. Garantia de devolução do dinheiro em 60 dias.

Leia mais... Download grátis... Compra...

Guia do Office traz interface com guias para o Office e torna seu trabalho muito mais fácil

Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!

Leia mais... Download grátis... Compra...

Comentários (5)

Ainda não há classificações. Seja o primeiro a avaliar!

cerca de mês 3 atrás

#40764

Este comentário foi feito pelo moderador no site

Oi,

Como posso fazer isso se minhas listas suspensas estiverem em intervalos diferentes? Para elaborar, tenho uma lista suspensa na folha 7 que está na célula B7 e a mesma lista suspensa na folha 6 na célula B2.

Obrigado,
Elaine

Resposta

cristal E

cerca de mês 3 atrás

#40859

Este comentário foi feito pelo moderador no site

Olá E,
O seguinte código VBA pode ajudar.
Aqui eu tomo Sheet6 como a planilha principal, clique com o botão direito do mouse na guia da planilha, selecione View Code no menu do botão direito e copie o seguinte código na janela Sheet6 (Code). Quando você seleciona qualquer item da lista suspensa em B2 da Planilha6, a lista suspensa em B7 da Planilha7 será sincronizada para ter o mesmo item selecionado.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221025
    Dim tSheet1 As Worksheet
    Dim tRange As Range
    Dim xRangeStr As String
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    
    xRangeStr = "B2"
    
    Set tRange = Range("B7")
    If Not tRange Is Nothing Then
        xRangeStr = tRange.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Application.EnableEvents = True
    End If
    
End Sub

Resposta

Report

E cristal

cerca de mês 3 atrás

#40915

Este comentário foi feito pelo moderador no site

Olá Cristal,

Muito obrigado pela resposta, seu código funcionou! Eu tenho uma célula logo abaixo de b2 e b7, b3 e b8 respectivamente que precisam ter a mesma função. Tentei reescrever seu código como mostrado abaixo, porém isso não funcionou. Isso fez com que b7 em vez de b8 mudasse quando mudei b3. Você poderia identificar o que estou fazendo de errado?

Muito obrigado!

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221025
    Dim tSheet1 As Worksheet
    Dim tRange1 As Range
    Dime tRange2 As Range
    Dim xRangeStr1 As String
    Dim xRangeStr2 As String
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    
    xRangeStr1 = "B2"
    xRangeStr2="B3"
    
    Set tRange1 = Range("B7")
    If Not tRange1 Is Nothing Then
        xRangeStr1 = tRange1.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
        tSheet1.Range(xRangeStr1).Value = Target.Value
        Application.EnableEvents = True
    End If
    
    Set tRange2 = Range("B8")
    If Not tRange2 Is Nothing Then
        xRangeStr2 = tRange2.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
        tSheet1.Range(xRangeStr2).Value = Target.Value
        Application.EnableEvents = True
    End If

End Sub

Resposta

cristal E

cerca de mês 2 atrás

#40991

Este comentário foi feito pelo moderador no site

Olá E,
Há algo errado com o código VBA que respondi acima.
Para a nova pergunta que você mencionou, tente o código a seguir.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221031
    
    Dim xBool1 As Boolean
    Dim xBool2 As Boolean
    Dim xRgStr As String
    Dim tRange As Range
    
    xRangeStr1 = "B2"
    xRangeStr2 = "B3"
    xRgStr = ""
    
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    xBool1 = Intersect(Target, Range(xRangeStr1)) Is Nothing
    xBool2 = Intersect(Target, Range(xRangeStr2)) Is Nothing
    
    If xBool1 And xBool2 Then Exit Sub
    
    xRgStr = Target.Address(False, False, xlA1, False, False)
    
    If Target.Address(False, False, xlA1, False, False) = xRangeStr1 Then
        xRgStr = "b7"
    ElseIf Target.Address(False, False, xlA1, False, False) = xRangeStr2 Then
        xRgStr = "b8"
    End If
    If xRgStr = "" Then Exit Sub
    
    Application.EnableEvents = False
    Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
    tSheet1.Range(xRgStr).Value = Target.Value
    Application.EnableEvents = True

End Sub

Resposta

Report

cerca de mês 3 atrás

#40890

Este comentário foi feito pelo moderador no site

Cristal,

Muito obrigado pela resposta, funcionou! Como eu poderia modificar o código para adicionar outra célula na mesma planilha 6, B3 que também precisava ser sincronizada com B8 na planilha 7? Tentei modificá-lo abaixo, porém acaba colocando o conteúdo de B3 na folha 6 em B7 na folha 7 ao invés de B8.

Private Sub Worksheet_Change (ByVal Target As Range)
'Atualizado por Extendoffice 20221025
Dim tSheet1 como planilha
Dim tRange1 como intervalo
Dim tRange2 como intervalo
Dim xRangeStr1 As String
Dim xRangeStr2 As String
On Error Resume Next
Se Target.Count > 1, então Exit Sub

xRangeStr1 = "B2"
xRangeStr2 = "B3"

Defina tRange1 = Range("B7")
Se não tRange1 não é nada, então
xRangeStr1 = tRange1.Address
Application.EnableEvents = False
Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
tSheet1.Range(xRangeStr1).Value = Target.Value
Application.EnableEvents = True
Se acabar

Defina tRange2 = Range("B8")
Se não tRange2 não é nada, então
xRangeStr2 = tRange2.Address
Application.EnableEvents = False
Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
tSheet1.Range(xRangeStr2).Value = Target.Value
Application.EnableEvents = True
Se acabar

End Sub

Resposta

Não há comentários postados aqui ainda

Deixe o seu comentário

Postando como convidado

Entrar

Nome (obrigatório)

Email (obrigatório)

Avalie esta postagem:

Limpar

0 Personagens

Eu concordo com o termos e condições