100 Códigos VBA Excel para Automatizar Tarefas

Olá! Aqui estão 100 Códigos VBA Excel para Automatizar Tarefas e Otimizar Seu Fluxo de Trabalho no Microsoft Excel.

Se você trabalha com o Microsoft Excel, sabe o quanto pode ser frustrante gastar horas realizando tarefas repetitivas e cansativas.

A boa notícia é que, com a ajuda do VBA Excel, é possível automatizar muitas dessas tarefas e otimizar seu fluxo de trabalho, economizando tempo e esforço.

Neste guia, apresentaremos 100 códigos VBA Excel para ajudá-lo a aproveitar ao máximo essa ferramenta poderosa e tornar suas tarefas diárias mais eficientes.”

O VBA Excel é uma linguagem de programação que permite automatizar e personalizar ações no Excel.

Com o VBA, é possível criar macros que executam uma série de tarefas repetitivas com apenas um clique, ou até mesmo integrar o Excel com outras ferramentas do Microsoft Office e bancos de dados externos.

Neste guia, apresentaremos uma variedade de códigos VBA Excel para ajudá-lo a automatizar tarefas comuns, como formatação condicional, classificação de dados, criação de gráficos, e muito mais.

Os códigos são projetados para serem fáceis de implementar e personalizar, mesmo para aqueles com pouca experiência em programação.

Com 100 Códigos VBA Excel para Automatizar Tarefas à disposição, você poderá economizar tempo e esforço em suas tarefas diárias, permitindo que você se concentre em tarefas mais importantes e estratégicas.

Esperamos que este guia tenha sido útil para você e que tenha encontrado os códigos VBA Excel necessários para automatizar suas tarefas e otimizar seu fluxo de trabalho.

Lembre-se, o VBA Excel é uma ferramenta poderosa que pode ajudá-lo a economizar tempo e esforço, mas também pode ser um pouco intimidante para iniciantes.

Não hesite em experimentar e personalizar esses códigos para atender às suas necessidades específicas.

Com um pouco de prática e experiência, você pode se tornar um expert em VBA Excel e levar sua produtividade a um novo nível.

1 – Criar uma nova planilha.

Sub CriarNovaPlanilha()
    'Criar uma nova planilha
    Dim novaPlanilha As Worksheet
    Set novaPlanilha = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    novaPlanilha.Name = "Nova Planilha"
End Sub

2 – Excluir uma planilha existente.

Sub ExcluirPlanilhaExistente()
    'Excluir uma planilha existente
    Dim nomePlanilha As String
    nomePlanilha = "Nome da Planilha" ' Substitua "Nome da Planilha" pelo nome da planilha que deseja excluir
    
    Dim planilha As Worksheet
    Set planilha = Nothing
    
    On Error Resume Next ' Ignora erros caso a planilha não exista
    Set planilha = ThisWorkbook.Worksheets(nomePlanilha)
    On Error GoTo 0 ' Retoma a captura de erros
    
    If Not planilha Is Nothing Then
        Application.DisplayAlerts = False ' Ignora o alerta de confirmação de exclusão
        planilha.Delete
        Application.DisplayAlerts = True ' Retoma o alerta de confirmação de exclusão
    Else
        MsgBox "Planilha não encontrada.", vbCritical ' Exibe uma mensagem de erro caso a planilha não exista
    End If
End Sub

3 – Copiar uma planilha existente.

Sub CopiarPlanilhaExistente()
    'Copiar uma planilha existente
    Dim nomePlanilha As String
    nomePlanilha = "Nome da Planilha" ' Substitua "Nome da Planilha" pelo nome da planilha que deseja copiar
    
    Dim planilha As Worksheet
    Set planilha = Nothing
    
    On Error Resume Next ' Ignora erros caso a planilha não exista
    Set planilha = ThisWorkbook.Worksheets(nomePlanilha)
    On Error GoTo 0 ' Retoma a captura de erros
    
    If Not planilha Is Nothing Then
        planilha.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) ' Copia a planilha para o final da pasta de trabalho
        ' É possível definir outro local utilizando a propriedade "Before" ou "After"
        ' Exemplo: planilha.Copy Before:=ThisWorkbook.Sheets("Nome da Outra Planilha")
        
        Dim novaPlanilha As Worksheet
        Set novaPlanilha = ActiveSheet
        novaPlanilha.Name = "Cópia de " & nomePlanilha ' Define o nome da nova planilha como "Cópia de {nome da planilha original}"
    Else
        MsgBox "Planilha não encontrada.", vbCritical ' Exibe uma mensagem de erro caso a planilha não exista
    End If
End Sub

4 – Mover uma planilha para uma nova posição.

Sub MoverPlanilha()
    'Mover uma planilha para uma nova posição
    Dim nomePlanilha As String
    nomePlanilha = "Nome da Planilha" ' Substitua "Nome da Planilha" pelo nome da planilha que deseja mover
    
    Dim planilha As Worksheet
    Set planilha = Nothing
    
    On Error Resume Next ' Ignora erros caso a planilha não exista
    Set planilha = ThisWorkbook.Worksheets(nomePlanilha)
    On Error GoTo 0 ' Retoma a captura de erros
    
    If Not planilha Is Nothing Then
        Dim posicao As Long
        posicao = 1 ' Substitua "1" pela posição desejada (exemplo: 2 para mover para a segunda posição)
        
        If posicao > ThisWorkbook.Sheets.Count Then
            posicao = ThisWorkbook.Sheets.Count ' Caso a posição desejada seja maior que a quantidade de planilhas, move para o final
        End If
        
        planilha.Move After:=ThisWorkbook.Sheets(posicao - 1) ' Move a planilha para a posição desejada
        
        ' É possível definir outra planilha de referência utilizando a propriedade "Before" ou "After"
        ' Exemplo: planilha.Move Before:=ThisWorkbook.Sheets("Nome da Outra Planilha")
    Else
        MsgBox "Planilha não encontrada.", vbCritical ' Exibe uma mensagem de erro caso a planilha não exista
    End If
End Sub

5 – Renomear uma planilha existente.

Sub RenomearPlanilha()
    'Renomear uma planilha existente
    Dim nomePlanilha As String
    nomePlanilha = "Nome da Planilha" ' Substitua "Nome da Planilha" pelo nome da planilha que deseja renomear
    
    Dim planilha As Worksheet
    Set planilha = Nothing
    
    On Error Resume Next ' Ignora erros caso a planilha não exista
    Set planilha = ThisWorkbook.Worksheets(nomePlanilha)
    On Error GoTo 0 ' Retoma a captura de erros
    
    If Not planilha Is Nothing Then
        Dim novoNome As String
        novoNome = "Novo Nome da Planilha" ' Substitua "Novo Nome da Planilha" pelo nome desejado
        
        planilha.Name = novoNome ' Renomeia a planilha
        
        ' Também é possível utilizar a variável "InputBox" para permitir que o usuário digite o novo nome
        ' Exemplo: novoNome = InputBox("Digite o novo nome da planilha", "Renomear planilha")
    Else
        MsgBox "Planilha não encontrada.", vbCritical ' Exibe uma mensagem de erro caso a planilha não exista
    End If
End Sub

6 – Adicionar ou remover colunas.

Sub AdicionarOuRemoverColunas()
    'Adicionar ou remover colunas em uma planilha existente
    Dim nomePlanilha As String
    nomePlanilha = "Nome da Planilha" ' Substitua "Nome da Planilha" pelo nome da planilha que deseja adicionar ou remover colunas
    
    Dim planilha As Worksheet
    Set planilha = Nothing
    
    On Error Resume Next ' Ignora erros caso a planilha não exista
    Set planilha = ThisWorkbook.Worksheets(nomePlanilha)
    On Error GoTo 0 ' Retoma a captura de erros
    
    If Not planilha Is Nothing Then
        Dim colunaInicial As Long
        colunaInicial = 1 ' Substitua "1" pela coluna inicial desejada
        
        Dim qtdeColunas As Long
        qtdeColunas = 2 ' Substitua "2" pela quantidade de colunas que deseja adicionar (negativo para remover)
        
        If colunaInicial + qtdeColunas < 1 Then
            MsgBox "Não é possível remover todas as colunas da planilha.", vbCritical ' Exibe uma mensagem de erro caso tente remover todas as colunas
            Exit Sub
        End If
        
        planilha.Columns(colunaInicial).Resize(, qtdeColunas).Insert Shift:=xlToRight ' Adiciona ou remove colunas
        
        ' O parâmetro "Shift" pode ser utilizado para controlar como as outras colunas serão deslocadas
        ' Exemplo: planilha.Columns(colunaInicial).Resize(, qtdeColunas).Insert Shift:=xlToLeft
        
        ' Caso não queira remover colunas, basta alterar o valor de "qtdeColunas" para zero ou um número positivo
    Else
        MsgBox "Planilha não encontrada.", vbCritical ' Exibe uma mensagem de erro caso a planilha não exista
    End If
End Sub

7 – Adicionar ou remover linhas.

Sub AdicionarOuRemoverLinhas()
    'Adicionar ou remover linhas em uma planilha existente
    Dim nomePlanilha As String
    nomePlanilha = "Nome da Planilha" ' Substitua "Nome da Planilha" pelo nome da planilha que deseja adicionar ou remover linhas
    
    Dim planilha As Worksheet
    Set planilha = Nothing
    
    On Error Resume Next ' Ignora erros caso a planilha não exista
    Set planilha = ThisWorkbook.Worksheets(nomePlanilha)
    On Error GoTo 0 ' Retoma a captura de erros
    
    If Not planilha Is Nothing Then
        Dim linhaInicial As Long
        linhaInicial = 1 ' Substitua "1" pela linha inicial desejada
        
        Dim qtdeLinhas As Long
        qtdeLinhas = 2 ' Substitua "2" pela quantidade de linhas que deseja adicionar (negativo para remover)
        
        If linhaInicial + qtdeLinhas < 1 Then
            MsgBox "Não é possível remover todas as linhas da planilha.", vbCritical ' Exibe uma mensagem de erro caso tente remover todas as linhas
            Exit Sub
        End If
        
        planilha.Rows(linhaInicial).Resize(qtdeLinhas).Insert Shift:=xlDown ' Adiciona ou remove linhas
        
        ' O parâmetro "Shift" pode ser utilizado para controlar como as outras linhas serão deslocadas
        ' Exemplo: planilha.Rows(linhaInicial).Resize(qtdeLinhas).Insert Shift:=xlUp
        
        ' Caso não queira remover linhas, basta alterar o valor de "qtdeLinhas" para zero ou um número positivo
    Else
        MsgBox "Planilha não encontrada.", vbCritical ' Exibe uma mensagem de erro caso a planilha não exista
    End If
End Sub

8 – Ajustar o tamanho das colunas automaticamente.

Sub AjustarTamanhoColunas()
    'Ajustar automaticamente o tamanho das colunas em uma planilha
    Dim nomePlanilha As String
    nomePlanilha = "Nome da Planilha" ' Substitua "Nome da Planilha" pelo nome da planilha que deseja ajustar o tamanho das colunas
    
    Dim planilha As Worksheet
    Set planilha = Nothing
    
    On Error Resume Next ' Ignora erros caso a planilha não exista
    Set planilha = ThisWorkbook.Worksheets(nomePlanilha)
    On Error GoTo 0 ' Retoma a captura de erros
    
    If Not planilha Is Nothing Then
        planilha.Columns.AutoFit ' Ajusta automaticamente o tamanho das colunas da planilha
    Else
        MsgBox "Planilha não encontrada.", vbCritical ' Exibe uma mensagem de erro caso a planilha não exista
    End If
End Sub

9 – Ajustar o tamanho das linhas automaticamente.

Sub AjustarTamanhoLinhas()
    'Ajustar automaticamente o tamanho das linhas em uma planilha
    Dim nomePlanilha As String
    nomePlanilha = "Nome da Planilha" ' Substitua "Nome da Planilha" pelo nome da planilha que deseja ajustar o tamanho das linhas
    
    Dim planilha As Worksheet
    Set planilha = Nothing
    
    On Error Resume Next ' Ignora erros caso a planilha não exista
    Set planilha = ThisWorkbook.Worksheets(nomePlanilha)
    On Error GoTo 0 ' Retoma a captura de erros
    
    If Not planilha Is Nothing Then
        planilha.Rows.AutoFit ' Ajusta automaticamente o tamanho das linhas da planilha
    Else
        MsgBox "Planilha não encontrada.", vbCritical ' Exibe uma mensagem de erro caso a planilha não exista
    End If
End Sub

10 – Inserir um comentário em uma célula.

Sub InserirComentario()
    'Inserir um comentário em uma célula
    Dim nomePlanilha As String
    nomePlanilha = "Nome da Planilha" ' Substitua "Nome da Planilha" pelo nome da planilha onde está a célula
    
    Dim celula As Range
    Set celula = Nothing
    
    On Error Resume Next ' Ignora erros caso a célula não exista
    Set celula = ThisWorkbook.Worksheets(nomePlanilha).Range("A1") ' Substitua "A1" pela referência da célula onde deseja inserir o comentário
    On Error GoTo 0 ' Retoma a captura de erros
    
    If Not celula Is Nothing Then
        celula.ClearComments ' Limpa qualquer comentário existente na célula
        celula.AddComment "Este é um comentário de exemplo." ' Insere um novo comentário na célula
    Else
        MsgBox "Célula não encontrada.", vbCritical ' Exibe uma mensagem de erro caso a célula não exista
    End If
End Sub

11 – Remover um comentário em uma célula.

Sub RemoverComentario()
    If Not ActiveCell.Comment Is Nothing Then
        ActiveCell.Comment.Delete
    End If
End Sub

12 – Proteger uma planilha com senha.

Sub ProtegerPlanilha()
    Dim senha As String
    senha = InputBox("Digite a senha para proteger a planilha:")
    If senha <> "" Then
        ActiveSheet.Protect Password:=senha
    End If
End Sub

13 – Desproteger uma planilha com senha.

Sub DesprotegerPlanilha()
    Dim senha As String
    senha = InputBox("Digite a senha para desproteger a planilha:")
    If senha <> "" Then
        ActiveSheet.Unprotect Password:=senha
    End If
End Sub

14 – Copiar células de uma planilha para outra.

Sub CopiarCelulas()
    ' Define as células que serão copiadas
    Dim planilhaOrigem As Worksheet
    Dim celulaOrigem As Range
    Set planilhaOrigem = Worksheets("Planilha1") ' nome da planilha de origem
    Set celulaOrigem = planilhaOrigem.Range("A1:C5") ' intervalo de células que serão copiadas
    
    ' Define a planilha de destino e a célula de destino
    Dim planilhaDestino As Worksheet
    Dim celulaDestino As Range
    Set planilhaDestino = Worksheets("Planilha2") ' nome da planilha de destino
    Set celulaDestino = planilhaDestino.Range("A1") ' célula de destino
    
    ' Copia as células para a planilha de destino
    celulaOrigem.Copy celulaDestino
End Sub

15 – Mover células de uma planilha para outra.

Sub MoverCelulas()
    ' Define as células que serão movidas
    Dim planilhaOrigem As Worksheet
    Dim celulaOrigem As Range
    Set planilhaOrigem = Worksheets("Planilha1") ' nome da planilha de origem
    Set celulaOrigem = planilhaOrigem.Range("A1:C5") ' intervalo de células que serão movidas
    
    ' Define a planilha de destino e a célula de destino
    Dim planilhaDestino As Worksheet
    Dim celulaDestino As Range
    Set planilhaDestino = Worksheets("Planilha2") ' nome da planilha de destino
    Set celulaDestino = planilhaDestino.Range("A1") ' célula de destino
    
    ' Move as células para a planilha de destino
    celulaOrigem.Cut celulaDestino
End Sub

16 – Copiar uma fórmula para uma célula em branco abaixo.

Sub CopiarFormula()
    ' Seleciona a célula com a fórmula a ser copiada
    Dim celulaOrigem As Range
    Set celulaOrigem = ActiveCell ' célula selecionada
    
    ' Copia a fórmula para a célula abaixo
    celulaOrigem.Copy celulaOrigem.Offset(1, 0)
End Sub

17 – Copiar uma fórmula para uma célula em branco ao lado.

Sub CopiarFormula()
    ' Seleciona a célula com a fórmula a ser copiada
    Dim celulaOrigem As Range
    Set celulaOrigem = ActiveCell ' célula selecionada
    
    ' Copia a fórmula para a célula à direita
    celulaOrigem.Copy celulaOrigem.Offset(0, 1)
End Sub

18 – Copiar uma fórmula para uma célula em branco acima.

Sub CopiarFormula()
    ' Seleciona a célula com a fórmula a ser copiada
    Dim celulaOrigem As Range
    Set celulaOrigem = ActiveCell ' célula selecionada
    
    ' Copia a fórmula para a célula acima
    celulaOrigem.Copy celulaOrigem.Offset(-1, 0)
End Sub

19 – Copiar uma fórmula para uma célula em branco à direita.

Sub CopiarFormula()
    ' Seleciona a célula com a fórmula a ser copiada
    Dim celulaOrigem As Range
    Set celulaOrigem = ActiveCell ' célula selecionada
    
    ' Copia a fórmula para a célula à direita
    celulaOrigem.Copy celulaOrigem.Offset(0, 1)
End Sub

20 – Adicionar um gráfico à planilha.

Sub AdicionarGrafico()
    ' Define as variáveis
    Dim tabela As Range
    Dim grafico As Chart
    
    ' Seleciona a tabela de dados
    Set tabela = Range("A1:C10") ' altere para a sua tabela de dados
    
    ' Cria um novo gráfico
    Set grafico = ActiveSheet.Shapes.AddChart2(251, xlColumnClustered).Chart
    
    ' Define as propriedades do gráfico
    With grafico
        .SetSourceData tabela
        .HasTitle = True
        .ChartTitle.Text = "Título do gráfico"
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = "Título do eixo X"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Text = "Título do eixo Y"
    End With
End Sub

21 – Atualizar um gráfico existente na planilha

Sub AtualizarGrafico()
    
    Dim Grafico As ChartObject
    
    'Defina o gráfico a ser atualizado
    Set Grafico = ActiveSheet.ChartObjects("Nome do Gráfico")
    
    'Atualize o gráfico
    Grafico.Chart.Refresh
    
End Sub

22 – Remover um gráfico da planilha

Sub RemoverGrafico()
    
    Dim Grafico As ChartObject
    
    'Defina o gráfico a ser removido
    Set Grafico = ActiveSheet.ChartObjects("Nome do Gráfico")
    
    'Remova o gráfico
    Grafico.Delete
    
End Sub

23 – Definir uma área de impressão

Sub DefinirAreaDeImpressao()

    'Defina a planilha que contém a área de impressão
    Dim planilha As Worksheet
    Set planilha = ThisWorkbook.Worksheets("Nome da Planilha")
    
    'Defina a área de impressão
    Dim areaDeImpressao As Range
    Set areaDeImpressao = planilha.Range("A1:F20") 'Substitua pelos endereços da célula desejados
    
    'Defina a área de impressão na planilha
    planilha.PageSetup.PrintArea = areaDeImpressao.Address
    
End Sub

24 – Imprimir a planilha

Sub ImprimirPlanilha()

    'Defina a planilha a ser impressa
    Dim planilha As Worksheet
    Set planilha = ThisWorkbook.Worksheets("Nome da Planilha")
    
    'Defina a área de impressão
    Dim areaDeImpressao As Range
    Set areaDeImpressao = planilha.UsedRange 'Usa toda a planilha
    
    'Defina as configurações de impressão
    With planilha.PageSetup
        .Orientation = xlPortrait 'Retrato
        .FitToPagesWide = 1 'Uma página de largura
        .FitToPagesTall = False 'Número de páginas de altura
    End With
    
    'Imprima a planilha
    areaDeImpressao.PrintOut
    
End Sub

25 – Adicionar ou remover bordas em torno das células

Sub AdicionarBordas()

    'Defina a seleção de células que você deseja adicionar bordas
    Dim selecao As Range
    Set selecao = Selection 'Seleção atual no Excel
    
    'Adicione as bordas
    selecao.BorderAround xlContinuous, xlThin, RGB(0, 0, 0) 'Borda contínua e fina em preto
    
End Sub

Sub RemoverBordas()

    'Defina a seleção de células que você deseja remover as bordas
    Dim selecao As Range
    Set selecao = Selection 'Seleção atual no Excel
    
    'Remova as bordas
    selecao.Borders.LineStyle = xlNone 'Sem bordas
    
End Sub

26 – Alterar a cor das células

Sub AlterarCorDasCelulas()

    'Defina a seleção de células que você deseja alterar a cor
    Dim selecao As Range
    Set selecao = Selection 'Seleção atual no Excel
    
    'Altere a cor das células para vermelho
    selecao.Interior.Color = RGB(255, 0, 0) 'Vermelho
    
End Sub

27 – Alterar a fonte das células

Sub AlterarFonteDasCelulas()

    'Defina a seleção de células que você deseja alterar a fonte
    Dim selecao As Range
    Set selecao = Selection 'Seleção atual no Excel
    
    'Altere a fonte das células para Arial e tamanho 12
    selecao.Font.Name = "Arial"
    selecao.Font.Size = 12
    
End Sub

28 – Alterar o tamanho da fonte das células

Sub AlterarTamanhoDaFonteDasCelulas()

    'Defina a seleção de células que você deseja alterar o tamanho da fonte
    Dim selecao As Range
    Set selecao = Selection 'Seleção atual no Excel
    
    'Altere o tamanho da fonte das células para 14
    selecao.Font.Size = 14
    
End Sub

29 – Adicionar ou remover negrito nas células

Sub AdicionarNegrito()

    'Defina a seleção de células que você deseja adicionar negrito
    Dim selecao As Range
    Set selecao = Selection 'Seleção atual no Excel
    
    'Adicione o negrito nas células
    selecao.Font.Bold = True
    
End Sub

Sub RemoverNegrito()

    'Defina a seleção de células que você deseja remover o negrito
    Dim selecao As Range
    Set selecao = Selection 'Seleção atual no Excel
    
    'Remova o negrito das células
    selecao.Font.Bold = False
    
End Sub

30 – Adicionar ou remover itálico nas células

Sub AdicionarItalico()

    'Defina a seleção de células que você deseja adicionar itálico
    Dim selecao As Range
    Set selecao = Selection 'Seleção atual no Excel
    
    'Adicione o estilo itálico nas células
    selecao.Font.Italic = True
    
End Sub

Sub RemoverItalico()

    'Defina a seleção de células que você deseja remover o itálico
    Dim selecao As Range
    Set selecao = Selection 'Seleção atual no Excel
    
    'Remova o estilo itálico das células
    selecao.Font.Italic = False
    
End Sub

31 – Adicionar ou remover sublinhado nas células

Sub AdicionarSublinhado()
    'Seleciona a célula ativa ou o intervalo selecionado
    Selection.Font.Underline = xlUnderlineStyleSingle

'Adiciona sublinhado simples; use xlUnderlineStyleDouble para sublinhado duplo

End Sub

Sub RemoverSublinhado()
    'Seleciona a célula ativa ou o intervalo selecionado
    Selection.Font.Underline = False 'Remove o sublinhado
End Sub

32 – Adicionar ou remover texto tachado nas células

Sub AdicionarTextoTachado()
    'Seleciona a célula ativa ou o intervalo selecionado
    Selection.Font.Strikethrough = True
End Sub

Sub RemoverTextoTachado()
'Seleciona a célula ativa ou o intervalo selecionado
Selection.Font.Strikethrough = False
End Sub

33 – Adicionar ou remover fonte em caixa alta nas células

Sub RemoverCaixaAlta()
    'Seleciona a célula ativa ou o intervalo selecionado
    Selection.Value = LCase(Selection.Value)
End Sub

34 – Adicionar ou remover fonte em caixa baixa nas células

Sub AdicionarCaixaBaixa()
    'Seleciona a célula ativa ou o intervalo selecionado
    Selection.Value = LCase(Selection.Value)
End Sub

Sub RemoverCaixaBaixa()
    'Seleciona a célula ativa ou o intervalo selecionado
    Selection.Value = UCase(Selection.Value)
End Sub

35 – Adicionar uma data atual em uma célula

Sub AdicionarDataAtual()
    'Seleciona a célula ativa
    ActiveCell.Value = Date 'Insere a data atual na célula ativa
End Sub

36 – Adicionar uma hora atual em uma célula

Sub AdicionarHoraAtual()
    'Seleciona a célula ativa
    ActiveCell.Value = Time 'Insere a hora atual na célula ativa
End Sub

37 – Somar uma coluna ou linha de números

Sub SomarColuna()
    Dim Soma As Double 'Declara uma variável para armazenar a soma
    Soma = Application.WorksheetFunction.Sum(Columns("A")) 'Substitua "A" pela letra da coluna que deseja somar
    MsgBox "A soma da coluna é: " & Soma 'Exibe a soma em uma mensagem de caixa de diálogo
End Sub

Sub SomarLinha()
Dim Soma As Double 'Declara uma variável para armazenar a soma
Soma = Application.WorksheetFunction.Sum(Rows("1")) 'Substitua "1" pelo número da linha que deseja somar
MsgBox "A soma da linha é: " & Soma 'Exibe a soma em uma mensagem de caixa de diálogo
End Sub

38 – Subtrair uma coluna ou linha de números

Sub SubtrairColuna()
    Dim Resultado As Double 'Declara uma variável para armazenar o resultado
    Resultado = Application.WorksheetFunction.Sum(Columns("A")) - Application.WorksheetFunction.Sum(Columns("B")) 'Substitua "A" e "B" pelas letras das colunas que deseja subtrair
    MsgBox "O resultado da subtração é: " & Resultado 'Exibe o resultado em uma mensagem de caixa de diálogo
End Sub

39 – Multiplicar uma coluna ou linha de números

Sub MultiplicarColuna()
    Dim Resultado As Double 'Declara uma variável para armazenar o resultado
    Resultado = Application.WorksheetFunction.Product(Columns("A")) 'Substitua "A" pela letra da coluna que deseja multiplicar
    MsgBox "O resultado da multiplicação é: " & Resultado 'Exibe o resultado em uma mensagem de caixa de diálogo
End Sub

40 – Dividir uma coluna ou linha de números

Sub DividirColuna()
Dim Resultado As Double 'Declara uma variável para armazenar o resultado
Resultado = Application.WorksheetFunction.Quotient(Columns("A"), Columns("B")) 'Substitua "A" e "B" pelas letras das colunas que deseja dividir
MsgBox "O resultado da divisão é: " & Resultado 'Exibe o resultado em uma mensagem de caixa de diálogo
End Sub

41 – Arredondar um número para cima

Sub ArredondarParaCima()
    Dim Numero As Double 'Declara uma variável para armazenar o número
    Dim Resultado As Double 'Declara uma variável para armazenar o resultado
    Numero = 12.345 'Substitua pelo número que deseja arredondar
    Resultado = Application.WorksheetFunction.RoundUp(Numero, 2) 'Substitua "2" pelo número de casas decimais que deseja arredondar
    MsgBox "O número arredondado para cima é: "

42 – Arredondar um número para baixo

Sub ArredondarParaBaixo()
    Dim Numero As Double 'Declara uma variável para armazenar o número
    Dim Resultado As Double 'Declara uma variável para armazenar o resultado
    Numero = 12.345 'Substitua pelo número que deseja arredondar
    Resultado = Application.WorksheetFunction.RoundDown(Numero, 2) 'Substitua "2" pelo número de casas decimais que deseja arredondar
    MsgBox "O número arredondado para baixo é: " & Resultado 'Exibe o resultado em uma mensagem de caixa de diálogo
End Sub

43 – Arredondar um número para o número inteiro mais próximo:

' Define uma variável do tipo Double
Dim x As Double

' Define um valor para a variável
x = 1,5

' Arredonda o valor da variável e exibe em uma caixa de mensagem
MsgBox Round(x)

44 – Encontrar o valor máximo em uma coluna ou linha:

' Define uma variável do tipo Range
Dim rng As Range

' Define um intervalo de células para a variável
Set rng = Range("A1:A10")

' Usa a função Max para encontrar o valor máximo no intervalo e exibe em uma caixa de mensagem
MsgBox WorksheetFunction.Max(rng)

45 – Encontrar o valor mínimo em uma coluna ou linha:

' Define uma variável do tipo Range
Dim rng As Range

' Define um intervalo de células para a variável
Set rng = Range("A1:A10")

' Usa a função Min para encontrar o valor mínimo no intervalo e exibe em uma caixa de mensagem
MsgBox WorksheetFunction.Min(rng)

46 – Calcular a média de uma coluna ou linha de números:

' Define uma variável do tipo Range
Dim rng As Range

' Define um intervalo de células para a variável
Set rng = Range("A1:A10")

' Usa a função Average para calcular a média dos valores no intervalo e exibe em uma caixa de mensagem
MsgBox WorksheetFunction.Average(rng)

47 – Calcular a mediana de uma coluna ou linha de números:

' Define uma variável do tipo Range
Dim rng As Range

' Define um intervalo de células para a variável
Set rng = Range("A1:A10")

' Usa a função Median para calcular a mediana dos valores no intervalo e exibe em uma caixa de mensagem
MsgBox WorksheetFunction.Median(rng)

48 – Calcular o desvio padrão de uma coluna ou linha de números:

' Define uma variável do tipo Range
Dim rng As Range

' Define um intervalo de células para a variável
Set rng = Range("A1:A10")

' Usa a função StDev para calcular o desvio padrão dos valores no intervalo e exibe em uma caixa de mensagem
MsgBox WorksheetFunction.StDev(rng)

49 – Ordenar uma coluna de dados em ordem crescente:

' Ordena as células na coluna A em ordem crescente e exibe os resultados na planilha
Range("A1:A10").Sort Key1:=Range("A1"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

50 – Ordenar uma coluna de dados em ordem decrescente

' Ordena as células na coluna A em ordem decrescente e exibe os resultados na planilha
Range("A1:A10").Sort Key1:=Range("A1"), _
Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

51 – Concatenar duas ou mais células

' Define uma variável do tipo String e concatena os valores das células A1, B1 e C1 na variável str 
Dim str As String
str = Range("A1").Value & Range("B1").Value & Range("C1").Value

' Insere o valor da variável str na célula D1 da planilha ativa 
Range("D1").Value = str 

52 – Separar o conteúdo de uma célula em várias células

Sub SepararConteudo()
'Seleciona a célula com o conteúdo que deseja separar
Range("A1").Select

'Usa a função Texto para Colunas para separar o conteúdo em células diferentes
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
    Comma:=True, Space:=False, Other:=False, _
    OtherChar:=",", FieldInfo:=Array(Array(1, 1), Array(2, 1), _
    Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True

End Sub

53 – Adicionar um cabeçalho à planilha

ActiveSheet.PageSetup.CenterHeader = "Meu Cabeçalho"

54 – Adicionar um rodapé à planilha

Sub AdicionarRodape()
    'Definir o conteúdo do rodapé
    Dim conteudoRodape As String
    conteudoRodape = "Texto do rodapé"
    
    'Definir a posição do rodapé (pode ser xlFooterMarginLeft, xlFooterMarginCenter ou xlFooterMarginRight)
    Dim posicaoRodape As XlHAlign
    posicaoRodape = xlFooterMarginCenter
    
    'Adicionar o rodapé à planilha
    ActiveSheet.PageSetup.CenterFooter = conteudoRodape
    ActiveSheet.PageSetup.AlignFooter = posicaoRodape
End Sub

55 – Copiar uma célula para várias células adjacentes

Sub CopiarCelulaParaCelsAdjacentes()
    'Seleciona a célula que contém o conteúdo a ser copiado
    Range("A1").Select
    
    'Define o número de células adjacentes que deseja preencher com o conteúdo copiado
    Dim numCelulas As Integer
    numCelulas = 5
    
    'Usa a função AutoFill para copiar o conteúdo para as células adjacentes
    Selection.AutoFill Destination:=Range("A1:A" & numCelulas), Type:=xlFillDefault
End Sub

56 – Alterar o tipo de letra em uma célula

Sub AlterarTipoDeLetra()
    'Seleciona a célula onde deseja alterar o tipo de letra
    Range("A1").Select
    
    'Define o novo tipo de letra que deseja usar (por exemplo, Arial)
    Dim novoTipoDeLetra As String
    novoTipoDeLetra = "Arial"
    
    'Altera o tipo de letra da célula selecionada para o novo tipo de letra definido
    Selection.Font.Name = novoTipoDeLetra
End Sub

57 – Ordenar dados em uma tabela por uma ou várias colunas, em ordem crescente ou decrescente

Sub OrdenarTabela()
    'Seleciona a tabela que deseja ordenar
    Dim minhaTabela As ListObject
    Set minhaTabela = ActiveSheet.ListObjects("MinhaTabela")
    
    'Seleciona a coluna que deseja usar para ordenar os dados
    Dim colunaParaOrdenar As Range
    Set colunaParaOrdenar = minhaTabela.ListColumns("Nome").Range
    
    'Ordena os dados na tabela pela coluna selecionada em ordem crescente
    minhaTabela.Sort.SortFields.Clear
    minhaTabela.Sort.SortFields.Add Key:=colunaParaOrdenar, _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With minhaTabela.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Para ordenar os dados em ordem decrescente, basta alterar o parâmetro “Order” de “xlAscending” para “xlDescending”:

minhaTabela.Sort.SortFields.Add Key:=colunaParaOrdenar, _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

58 – Adicionar um hyperlink a uma célula

Sub AdicionarHyperlink()
    'Seleciona a célula onde deseja adicionar o hyperlink
    Dim minhaCelula As Range
    Set minhaCelula = ActiveSheet.Range("A1")
    
    'Adiciona o hyperlink à célula selecionada
    minhaCelula.Hyperlinks.Add Anchor:=minhaCelula, _
        Address:="https://www.exemplo.com.br", TextToDisplay:="Texto do Link"
End Sub

59 – Remover um hyperlink de uma célula

Sub RemoverHyperlink()
    'Seleciona a célula onde deseja remover o hyperlink
    Dim minhaCelula As Range
    Set minhaCelula = ActiveSheet.Range("A1")
    
    'Remove o hyperlink da célula selecionada
    minhaCelula.Hyperlinks.Delete
End Sub

60 – Proteger células específicas da edição

Sub ProtegerCelulas()
    'Seleciona as células que deseja proteger
    Dim celulaProtegida As Range
    Set celulaProtegida = ActiveSheet.Range("A1")
    
    'Protege a planilha, com exceção da célula A2
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
        AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, _
        AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
        AllowDeletingColumns:=True, AllowDeletingRows:=True, _
        AllowSorting:=True, AllowFiltering:=True, _
        UserInterfaceOnly:=True
    celulaProtegida.Locked = True
    
    'Desprotege a célula A2
    ActiveSheet.Range("A2").Locked = False
End Sub

61 – Desproteger células específicas da edição

Sub DesprotegerCelula()
    'Seleciona a célula que deseja desproteger
    Dim celulaDesprotegida As Range
    Set celulaDesprotegida = ActiveSheet.Range("A1")
    
    'Desprotege a célula selecionada
    celulaDesprotegida.Locked = False
End Sub

62 – Adicionar uma mensagem de alerta em uma célula

Sub AdicionarMensagemDeAlerta()
    'Seleciona a célula que deseja adicionar a mensagem de alerta
    Dim celulaComMensagem As Range
    Set celulaComMensagem = ActiveSheet.Range("A1")
    
    'Define a mensagem de alerta
    Dim mensagem As String
    mensagem = "Digite um valor válido."
    
    'Adiciona a mensagem de alerta à célula selecionada
    With celulaComMensagem.Validation
        .Delete 'Remove qualquer validação existente na célula
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, _
             Operator:=xlBetween, Formula1:="0", Formula2:="9999" 'Define a nova validação
        .InputMessage = mensagem 'Define a mensagem de alerta
    End With
End Sub

63 – Adicionar uma mensagem de erro em uma célula

Sub AdicionarMensagemDeErro()
    'Seleciona a célula que deseja adicionar a mensagem de erro
    Dim celulaComMensagem As Range
    Set celulaComMensagem = ActiveSheet.Range("A1")
    
    'Define a mensagem de erro
    Dim mensagem As String
    mensagem = "Digite um valor válido."
    
    'Adiciona a mensagem de erro à célula selecionada
    With celulaComMensagem.Validation
        .Delete 'Remove qualquer validação existente na célula
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, _
             Operator:=xlBetween, Formula1:="0", Formula2:="9999" 'Define a nova validação
        .ErrorMessage = mensagem 'Define a mensagem de erro
    End With
End Sub

64 – Adicionar uma mensagem de ajuda em uma célula

Sub AdicionarMensagemDeAjuda()
    'Seleciona a célula que deseja adicionar a mensagem de ajuda
    Dim celulaComMensagem As Range
    Set celulaComMensagem = ActiveSheet.Range("A1")
    
    'Define a mensagem de ajuda
    Dim mensagem As String
    mensagem = "Digite um número inteiro entre 1 e 100."
    
    'Adiciona a mensagem de ajuda à célula selecionada
    celulaComMensagem.ClearComments 'Remove qualquer comentário existente na célula
    celulaComMensagem.AddComment mensagem 'Adiciona a mensagem de ajuda como um comentário
End Sub

65 – Adicionar uma lista suspensa em uma célula

Sub AdicionarListaSuspensa()
    'Seleciona a célula que deseja adicionar a lista suspensa
    Dim celulaComLista As Range
    Set celulaComLista = ActiveSheet.Range("A1")
    
    'Define as opções da lista suspensa
    Dim opcoes(1 To 3) As String
    opcoes(1) = "Opção 1"
    opcoes(2) = "Opção 2"
    opcoes(3) = "Opção 3"
    
    'Adiciona a lista suspensa à célula selecionada
    celulaComLista.Validation.Delete 'Remove qualquer validação existente na célula
    celulaComLista.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=Join(opcoes, ",") 'Adiciona a lista suspensa
End Sub

66 – Adicionar um botão à planilha

Sub AdicionarBotao()
    'Seleciona a célula onde deseja adicionar o botão
    Dim celulaBotao As Range
    Set celulaBotao = ActiveSheet.Range("A1")
    
    'Adiciona o botão à célula selecionada
    Dim botao As Shape
    Set botao = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, celulaBotao.Left, _
        celulaBotao.Top, 100, 30)
    botao.Name = "BotaoTeste"
    botao.TextFrame.Characters.Text = "Clique aqui"
    
    'Define a macro a ser executada quando o botão é clicado
    botao.OnAction = "MacroBotao"
End Sub

Sub MacroBotao()
    'Coloque aqui o código que deseja executar quando o botão é clicado
    MsgBox "Você clicou no botão!"
End Sub

67 – Adicionar uma caixa de seleção à planilha

Sub AdicionarCaixaDeSelecao()
    'Seleciona a célula onde deseja adicionar a caixa de seleção
    Dim celulaCaixaDeSelecao As Range
    Set celulaCaixaDeSelecao = ActiveSheet.Range("A1")
    
    'Adiciona a caixa de seleção à célula selecionada
    Dim caixaDeSelecao As CheckBox
    Set caixaDeSelecao = ActiveSheet.CheckBoxes.Add(celulaCaixaDeSelecao.Left, _
        celulaCaixaDeSelecao.Top, 100, 20)
    caixaDeSelecao.Name = "CaixaDeSelecaoTeste"
    
    'Define a célula vinculada à caixa de seleção
    caixaDeSelecao.LinkedCell = "B1"
End Sub

68 – Adicionar um controle de spin à planilha.

Sub AdicionarControleDeSpin()
    'Seleciona a célula onde deseja adicionar o controle de spin
    Dim celulaControleDeSpin As Range
    Set celulaControleDeSpin = ActiveSheet.Range("A1")
    
    'Adiciona o controle de spin à célula selecionada
    Dim controleDeSpin As SpinButton
    Set controleDeSpin = ActiveSheet.SpinButtons.Add(celulaControleDeSpin.Left, _
        celulaControleDeSpin.Top, 100, 20)
    controleDeSpin.Name = "ControleDeSpinTeste"
    
    'Define a célula vinculada e os valores mínimo, máximo e inicial
    controleDeSpin.LinkedCell = "B1"
    controleDeSpin.Min = 0
    controleDeSpin.Max = 100
    controleDeSpin.Value = 50
End Sub

69 – Adicionar um controle de barra de rolagem à planilha

Private Sub Worksheet_Activate()
    ' Cria uma nova barra de rolagem na planilha com as seguintes propriedades
    With Me.ScrollBars.Add(Left:=10, Top:=10, Width:=150, Height:=20)
        ' Define o valor máximo da barra de rolagem como 100
        .Max = 100
        ' Vincula a célula A1 à barra de rolagem, fazendo com que o valor da célula A1
        ' seja atualizado automaticamente com o valor da barra de rolagem
        .LinkedCell = Range("A1")
    End With
End Sub

70 – Adicionar uma imagem à planilha

Sub AddImage()
    Dim pic As Picture
    Set pic = ActiveSheet.Pictures.Insert("C:\path\to\image.jpg") ' substitua o caminho e o nome do arquivo de imagem pela localização do arquivo de imagem que deseja inserir na planilha
    pic.Left = Range("A1").Left ' posição horizontal da imagem na planilha
    pic.Top = Range("A1").Top ' posição vertical da imagem na planilha
End Sub

71 – Adicionar um vídeo à planilha.

Sub AddVideoLink()
    Range("A1").Hyperlinks.Add Anchor:=Range("A1"), Address:="https://www.youtube.com/watch?v=xxxxx" ' substitua o link pelo link do vídeo que deseja adicionar
End Sub

72 – Adicionar um áudio à planilha

Sub AddAudio()
    Dim snd As Object
    Set snd = ActiveSheet.OLEObjects.Add("wmplayer.OCX", False, False, 0, 0, 200, 200)
    snd.Object.URL = "C:\path\to\audiofile.mp3" ' Substitua o caminho e o nome do arquivo de áudio pelo arquivo de áudio que deseja adicionar
End Sub

73 – Adicionar um texto explicativo à planilha.

Sub AddText()
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50).TextFrame.Characters.Text = "Texto explicativo" ' Substitua "Texto explicativo" pelo texto que deseja adicionar
End Sub

74 – Adicionar um comentário de revisão à planilha

Sub AddReviewComment()
    Range("A1").AddComment "Comentário de revisão" ' Substitua "A1" pelo endereço da célula que deseja adicionar o comentário e "Comentário de revisão" pelo texto que deseja adicionar
    Range("A1").Comment.Author = "Nome do revisor" ' Substitua "Nome do revisor" pelo nome do revisor que adicionou o comentário
End Sub

75 – Adicionar uma senha para proteger uma macro.

Sub ProtegerMacroComSenha()
    Dim senha As String
    
    ' Solicita a senha para o usuário
    senha = InputBox("Insira a senha para proteger a macro:", "Proteger Macro com Senha")
    
    ' Verifica se a senha foi digitada
    If senha <> "" Then
        ' Protege o projeto com a senha digitada
        ThisWorkbook.VBProject.Protection.SetPassword senha
        ' Protege a macro especificada com a senha digitada
        ThisWorkbook.VBProject.VBComponents("NomeDoModulo").CodeModule.Protect senha
        MsgBox "A macro foi protegida com sucesso com a senha: " & senha
    Else
        MsgBox "A senha não pode ficar em branco. Tente novamente."
    End If
End Sub

76 – Atribuir uma macro a um botão

Sub AtribuirMacroAoBotao()

    'Declaração de variáveis
    Dim Planilha As Worksheet
    Dim Botao As Button
    
    'Definição da planilha e da posição do botão
    Set Planilha = ThisWorkbook.Worksheets("Planilha1")
    Set Botao = Planilha.Buttons.Add(10, 10, 50, 20)
    
    'Definição da macro a ser atribuída ao botão
    Botao.OnAction = "NomeDaMacro"
    
    'Definição do texto do botão
    Botao.Characters.Text = "Executar Macro"
    
End Sub

77 – Atribuir uma macro a uma tecla de atalho

Sub AtribuirAtalho()
    
    'Atribui a tecla de atalho CTRL+SHIFT+T para a macro "MinhaMacro"
    
    Application.OnKey "^+T", "MinhaMacro"
    
End Sub

78 – Atribuir uma macro a uma lista suspensa.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    'Verifica se a mudança ocorreu na célula onde está a lista suspensa
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        
        'Verifica se o valor selecionado na lista é igual a "Opção 1"
        If Target.Value = "Opção 1" Then
            
            'Chama a macro "MinhaMacro"
            MinhaMacro
            
        End If
        
    End If
    
End Sub

79 – Atribuir uma macro a uma caixa de seleção.

Private Sub CheckBox1_Click()

    'Verifica se a caixa de seleção foi marcada
    If CheckBox1.Value = True Then
        
        'Chama a macro "MinhaMacro"
        MinhaMacro
        
    End If
    
End Sub

80 – Atribuir uma macro a um controle de spin.

Private Sub SpinButton1_Change()

    'Chama a macro "MinhaMacro" com o valor do controle de spin como argumento
    MinhaMacro SpinButton1.Value
    
End Sub

81 – Atribuir uma macro a um controle de barra de rolagem

Private Sub ScrollBar1_Change()

    'Chama a macro "MinhaMacro" com o valor do controle de barra de rolagem como argumento
    MinhaMacro ScrollBar1.Value
    
End Sub

82 – Atribuir uma macro a um evento de planilha

Private Sub Worksheet_Change(ByVal Target As Range)

    'Verifica se a mudança ocorreu na célula desejada
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        
        'Chama a macro "MinhaMacro"
        MinhaMacro
        
    End If
    
End Sub

83 – Adicionar número de série

Sub AddSerialNumbers()
    Dim i As Integer
    
    ' Em caso de erro, ir para o rótulo "Último"
    On Error GoTo Último
    
    ' Solicita ao usuário para digitar o valor inicial dos números de série
    i = InputBox("Digite o valor inicial", "Digite os números de série")
    
    ' Loop para adicionar os números de série
    For i = 1 To i
        ' Define o valor atual da célula ativa como o número de série
        ActiveCell.Value = i
        
        ' Move para a próxima célula abaixo
        ActiveCell.Offset(1, 0).Activate
    Next i
    
    ' Rótulo "Último" para sair da sub-rotina
Último:
    Exit Sub
End Sub

84 – Inserir várias colunas

Sub InsertMultipleColumns()
    Dim i As Integer
    Dim j As Integer
    
    ' Seleciona a coluna inteira da célula ativa
    ActiveCell.EntireColumn.Select
    
    ' Em caso de erro, ir para o rótulo "Último"
    On Error GoTo Último
    
    ' Solicita ao usuário para digitar o número de colunas a serem inseridas
    i = InputBox("Digite o número de colunas a serem inseridas", "Inserir colunas")
    
    ' Loop para inserir as colunas
    For j = 1 To i
        ' Insere uma nova coluna à direita da seleção atual
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightOrAbove
    Next j
    
    ' Rótulo "Último" para sair da sub-rotina
Último:
    Exit Sub
End Sub

85 – Inserir várias linhas

Sub InsertMultipleRows()
    Dim i As Integer
    Dim j As Integer
    
    ' Seleciona a linha inteira da célula ativa
    ActiveCell.EntireRow.Select
    
    ' Em caso de erro, ir para o rótulo "Último"
    On Error GoTo Último
    
    ' Solicita ao usuário para digitar o número de linhas a serem inseridas
    i = InputBox("Digite o número de linhas a serem inseridas", "Inserir linhas")
    
    ' Loop para inserir as linhas
    For j = 1 To i
        ' Insere uma nova linha abaixo da seleção atual
        Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightOrAbove
    Next j
    
    ' Rótulo "Último" para sair da sub-rotina
Último:
    Exit Sub
End Sub

86 – Destaque a linha e a coluna ativas

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' Declaração da variável strRange para armazenar os endereços das células, colunas e linhas
    Dim strRange As String
    
    ' Concatena os endereços das células, colunas e linhas separados por vírgula
    strRange = Target.Cells.Address & "," & _
               Target.Cells.EntireColumn.Address & "," & _
               Target.Cells.EntireRow.Address
    
    ' Seleciona a faixa que inclui a célula, a coluna e a linha onde ocorreu o duplo clique
    Range(strRange).Select
End Sub

87 – Remova os decimais dos números

Sub removeDecimals()
    Dim lNumber As Double
    Dim lResultado As Long
    Dim rng As Range
    
    ' Percorre cada célula na seleção
    For Each rng In Selection
        ' Armazena o valor da célula em lNumber
        lNumber = rng.Value
        
        ' Arredonda o valor para o número inteiro mais próximo
        lResultado = Int(lNumber)
        
        ' Define o valor da célula como o número inteiro arredondado
        rng.Value = lResultado
        
        ' Define o formato da célula como "0" para remover as casas decimais
        rng.NumberFormat = "0"
    Next rng
End Sub

88 – Adicionar um botão de importação à planilha

Sub ImportarDados()
    Dim planilha As Worksheet
    Set planilha = ThisWorkbook.Sheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha

    Dim arquivo As Variant
    Dim linha As Long

    ' Abrir diálogo de seleção de arquivo
    arquivo = Application.GetOpenFilename("Arquivos CSV (*.csv), *.csv")

    ' Verificar se um arquivo foi selecionado
    If arquivo <> "Falso" Then
        ' Determinar a próxima linha vazia na planilha
        linha = planilha.Cells(planilha.Rows.Count, 1).End(xlUp).Row + 1
        
        ' Importar os dados do arquivo para a planilha
        With planilha.QueryTables.Add(Connection:="TEXT;" & arquivo, Destination:=planilha.Cells(linha, 1))
            .TextFileParseType = xlDelimited
            .TextFileCommaDelimiter = True ' Defina o delimitador apropriado
            .TextFileColumnDataTypes = Array(xlGeneralFormat) ' Defina os tipos de dados das colunas
            .Refresh BackgroundQuery:=False
        End With
    End If
End Sub

89 – Adicionar um botão de enviar e-mail à planilha

Sub AdicionarBotaoEnviarEmail()
    Dim ws As Worksheet
    Dim btn As Button
    Dim rng As Range

    ' Defina a planilha onde deseja adicionar o botão
    Set ws = ThisWorkbook.Sheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha

    ' Defina o range onde deseja posicionar o botão
    Set rng = ws.Range("A1") ' Substitua "A1" pela célula onde deseja posicionar o botão

    ' Insira um botão ActiveX na planilha
    Set btn = ws.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=rng.Left, Top:=rng.Top, Width:=100, Height:=30).Object

    ' Configurar propriedades do botão
    With btn
        .Caption = "Enviar E-mail" ' Texto exibido no botão
        .OnAction = "EnviarEmail" ' Nome da macro que será executada ao clicar no botão
    End With

    ' Adicione a macro para enviar e-mail (você precisa criar esta macro separadamente)
    Call AdicionarMacroEnviarEmail

    ' Limpe a memória
    Set ws = Nothing
    Set btn = Nothing
    Set rng = Nothing
End Sub

Sub AdicionarMacroEnviarEmail()
    ' Esta subrotina adiciona a macro para enviar e-mail

    Dim vbModule As Object
    Dim vbCode As String

    ' Verifique se o módulo já existe, caso contrário, crie um novo
    On Error Resume Next
    Set vbModule = ThisWorkbook.VBProject.VBComponents("Módulo1") ' Substitua "Módulo1" pelo nome desejado
    On Error GoTo 0

    If vbModule Is Nothing Then
        Set vbModule = ThisWorkbook.VBProject.VBComponents.Add(1) ' 1 indica um módulo de código
    End If

    ' Adicione o código VBA para enviar e-mail
    vbCode = "Sub EnviarEmail()" & vbCrLf & _
             "    Dim OutApp As Object" & vbCrLf & _
             "    Dim OutMail As Object" & vbCrLf & _
             "    Set OutApp = CreateObject(""Outlook.Application"")" & vbCrLf & _
             "    Set OutMail = OutApp.CreateItem(0)" & vbCrLf & _
             "    With OutMail" & vbCrLf & _
             "        .To = ""[email protected]""" & vbCrLf & _
             "        .Subject = ""Assunto do E-mail""" & vbCrLf & _
             "        .Body = ""Corpo do E-mail""" & vbCrLf & _
             "        .Send" & vbCrLf & _
             "    End With" & vbCrLf & _
             "    Set OutMail = Nothing" & vbCrLf & _
             "    Set OutApp = Nothing" & vbCrLf & _
             "End Sub"

    ' Insira o código no módulo
    vbModule.CodeModule.AddFromString vbCode

    ' Limpe a memória
    Set vbModule = Nothing
End Sub

90 – Adicionar um botão de preenchimento automático à planilha

Sub AdicionarBotaoPreenchimentoAutomatico()
    Dim botao As Object
    
    ' Verifique se o botão já existe e, se existir, exclua-o
    On Error Resume Next
    ThisWorkbook.Sheets("Planilha1").Shapes("BotaoPreenchimento").Delete
    On Error GoTo 0
    
    ' Crie um botão de forma retangular na planilha
    Set botao = ThisWorkbook.Sheets("Planilha1").Shapes.AddShape(msoShapeRectangle, 50, 50, 80, 30)
    
    ' Nomeie o botão
    botao.Name = "BotaoPreenchimento"
    
    ' Defina o rótulo do botão
    botao.TextFrame.Characters.Text = "Preencher"
    
    ' Adicione um código de macro para o botão
    botao.OnAction = "PreenchimentoAutomatico"
    
    ' Exiba o botão
    botao.Visible = True
End Sub

Sub PreenchimentoAutomatico()
    ' Coloque aqui o código para preenchimento automático
    ' Por exemplo, preencher uma célula com um valor
    ThisWorkbook.Sheets("Planilha1").Range("A1").Value = "Texto Preenchido"
End Sub

91 – Adicionar um botão de limpar formulário à planilha

Sub AdicionarBotaoLimparFormulario()
    Dim ws As Worksheet
    Dim btn As Button
    Dim rng As Range
    
    ' Defina a planilha onde você deseja adicionar o botão
    Set ws = ThisWorkbook.Worksheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha
    
    ' Defina a faixa onde você deseja adicionar o botão
    Set rng = ws.Range("A1") ' Substitua "A1" pela célula onde deseja posicionar o botão
    
    ' Crie o botão
    Set btn = ws.Buttons.Add(rng.Left, rng.Top, 100, 30) ' Ajuste as dimensões e a posição conforme necessário
    
    ' Configure o texto do botão
    btn.Text = "Limpar Formulário"
    
    ' Associe o botão a uma macro que irá limpar o formulário
    btn.OnAction = "LimparFormulario"
End Sub

Sub LimparFormulario()
    Dim ws As Worksheet
    Dim ctrl As OLEObject
    
    ' Defina a planilha onde estão os controles de formulário
    Set ws = ThisWorkbook.Worksheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha
    
    ' Percorra todos os controles de formulário na planilha
    For Each ctrl In ws.OLEObjects
        If TypeName(ctrl.Object) = "OptionButton" Or TypeName(ctrl.Object) = "CheckBox" Then
            ' Limpe opções de caixa de seleção ou botões de opção
            ctrl.Object.Value = False
        ElseIf TypeName(ctrl.Object) = "TextBox" Or TypeName(ctrl.Object) = "ComboBox" Then
            ' Limpe caixas de texto ou listas suspensas
            ctrl.Object.Text = ""
        End If
    Next ctrl
End Sub

92 – Adicionar um botão de copiar formulário à planilha

Sub AdicionarBotaoCopiarFormulario()
    Dim ws As Worksheet
    Dim btn As Button
    Dim rng As Range
    
    ' Defina a planilha onde você deseja adicionar o botão
    Set ws = ThisWorkbook.Worksheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha
    
    ' Defina a faixa onde você deseja adicionar o botão
    Set rng = ws.Range("A1") ' Substitua "A1" pela célula onde deseja posicionar o botão
    
    ' Crie o botão
    Set btn = ws.Buttons.Add(rng.Left, rng.Top, 100, 30) ' Ajuste as dimensões e a posição conforme necessário
    
    ' Configure o texto do botão
    btn.Text = "Copiar Formulário"
    
    ' Associe o botão a uma macro que irá copiar o formulário
    btn.OnAction = "CopiarFormulario"
End Sub

Sub CopiarFormulario()
    Dim ws As Worksheet
    Dim ctrl As OLEObject
    Dim destino As Range
    Dim linhaDestino As Long
    
    ' Defina a planilha onde estão os controles de formulário
    Set ws = ThisWorkbook.Worksheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha
    
    ' Defina a linha de destino onde os valores serão copiados
    linhaDestino = 2 ' Substitua pelo número da linha desejada
    
    ' Defina a faixa de destino
    Set destino = ws.Range("A" & linhaDestino) ' Ajuste a coluna conforme necessário
    
    ' Percorra todos os controles de formulário na planilha
    For Each ctrl In ws.OLEObjects
        If TypeName(ctrl.Object) = "OptionButton" Or TypeName(ctrl.Object) = "CheckBox" Then
            ' Copie opções de caixa de seleção ou botões de opção
            destino.Value = ctrl.Object.Value
        ElseIf TypeName(ctrl.Object) = "TextBox" Or TypeName(ctrl.Object) = "ComboBox" Then
            ' Copie caixas de texto ou listas suspensas
            destino.Value = ctrl.Object.Text
        End If
        ' Avance para a próxima coluna na mesma linha
        Set destino = destino.Offset(0, 1)
    Next ctrl
End Sub

93 – Adicionar um botão de colar formulário à planilha

Sub AdicionarBotaoColarFormulario()
    Dim ws As Worksheet
    Dim btn As Button
    Dim rng As Range
    
    ' Defina a planilha onde você deseja adicionar o botão
    Set ws = ThisWorkbook.Worksheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha
    
    ' Defina a faixa onde você deseja adicionar o botão
    Set rng = ws.Range("A1") ' Substitua "A1" pela célula onde deseja posicionar o botão
    
    ' Crie o botão
    Set btn = ws.Buttons.Add(rng.Left, rng.Top, 100, 30) ' Ajuste as dimensões e a posição conforme necessário
    
    ' Configure o texto do botão
    btn.Text = "Colar Formulário"
    
    ' Associe o botão a uma macro que irá colar o formulário
    btn.OnAction = "ColarFormulario"
End Sub

Sub ColarFormulario()
    Dim ws As Worksheet
    Dim linhaDestino As Long
    
    ' Defina a planilha onde você deseja colar o formulário
    Set ws = ThisWorkbook.Worksheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha
    
    ' Encontre a próxima linha vazia na coluna A (ou em outra coluna se preferir)
    linhaDestino = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
    
    ' Cole os valores da área de transferência na nova linha
    ws.Cells(linhaDestino, 1).PasteSpecial Paste:=xlPasteValues
End Sub

94 – Adicionar um botão de recortar formulário à planilha

Sub AdicionarBotaoRecortarFormulario()
    Dim ws As Worksheet
    Dim btn As Button
    Dim rng As Range
    
    ' Defina a planilha onde você deseja adicionar o botão
    Set ws = ThisWorkbook.Worksheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha
    
    ' Defina a faixa onde você deseja adicionar o botão
    Set rng = ws.Range("A1") ' Substitua "A1" pela célula onde deseja posicionar o botão
    
    ' Crie o botão
    Set btn = ws.Buttons.Add(rng.Left, rng.Top, 100, 30) ' Ajuste as dimensões e a posição conforme necessário
    
    ' Configure o texto do botão
    btn.Text = "Recortar Formulário"
    
    ' Associe o botão a uma macro que irá recortar o formulário
    btn.OnAction = "RecortarFormulario"
End Sub

Sub RecortarFormulario()
    Dim ws As Worksheet
    Dim rngOrigem As Range
    Dim rngDestino As Range
    
    ' Defina a planilha onde estão os controles de formulário
    Set ws = ThisWorkbook.Worksheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha
    
    ' Defina a faixa de origem a ser recortada (por exemplo, A1:C3)
    Set rngOrigem = ws.Range("A1:C3") ' Substitua pela faixa que deseja recortar
    
    ' Defina a faixa de destino onde os valores serão colados
    Set rngDestino = ws.Range("E1") ' Substitua pela célula de destino
    
    ' Recorte os valores da faixa de origem
    rngOrigem.Cut
    
    ' Cole os valores recortados na faixa de destino
    rngDestino.PasteSpecial Paste:=xlPasteValues
End Sub

95 – Adicionar um botão de desfazer formulário à planilha

Sub DesfazerFormulario()
    ' Defina a planilha onde o formulário está localizado
    Dim planilha As Worksheet
    Set planilha = ThisWorkbook.Sheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha
    
    ' Defina os intervalos de células do formulário que você deseja desfazer
    ' Substitua os intervalos pelos seus intervalos de formulário
    Dim intervalo1 As Range
    Set intervalo1 = planilha.Range("A1:A10")
    
    Dim intervalo2 As Range
    Set intervalo2 = planilha.Range("B1:B10")
    
    ' Desfazer o formulário, limpando os valores dos intervalos
    intervalo1.ClearContents
    intervalo2.ClearContents
    ' Continue limpando outros intervalos conforme necessário
End Sub

96 – Adicionar um botão de refazer formulário à planilha

Sub RefazerFormulario()
    Dim planilha As Worksheet
    Set planilha = ThisWorkbook.Sheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha
    
    ' Substitua os intervalos pelos seus intervalos de formulário
    planilha.Range("A1:A10").ClearContents
    planilha.Range("B1:B10").ClearContents
    ' Continue limpando outros intervalos conforme necessário
End Sub

97 – Adicionar um botão de classificar dados à planilha

Sub ClassificarDados()
    Dim planilha As Worksheet
    Set planilha = ThisWorkbook.Sheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha

    ' Substitua "A1:D100" pelo intervalo que você deseja classificar
    planilha.Range("A1:D100").Sort Key1:=planilha.Range("A1"), Order1:=xlAscending, Header:=xlYes
End Sub

Lembre-se de substituir “Planilha1” pelo nome da sua planilha e ajustar o intervalo conforme necessário.

7. Depois de inserir o código, feche o Editor VBA.

8. Na caixa de diálogo “Atribuir macro”, selecione a macro que você criou (por exemplo, “ClassificarDados”) e clique em “OK”.

9. Agora, sempre que você clicar no botão, a macro será executada e os dados no intervalo especificado serão classificados.

98 – Filtrar dados de uma planilha

Sub FiltrarDados()
    Dim planilha As Worksheet
    Dim intervaloFiltro As Range
    Dim intervaloCritério As Range
    Dim critério As Range
    
    ' Defina a planilha e o intervalo de dados que você deseja filtrar
    Set planilha = ThisWorkbook.Sheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha
    Set intervaloFiltro = planilha.Range("A1:D100") ' Substitua pelo intervalo de dados que você deseja filtrar
    
    ' Defina o intervalo de critério (coluna de critérios)
    Set intervaloCritério = planilha.Range("F1:F2") ' Substitua pelo intervalo de critérios
    
    ' Aplicar filtro para cada critério no intervalo de critérios
    For Each critério In intervaloCritério
        ' Verificar se o critério não está vazio
        If critério.Value <> "" Then
            ' Aplicar filtro
            intervaloFiltro.AutoFilter Field:=1, Criteria1:=critério.Value ' Substitua 1 pelo número da coluna que você deseja filtrar
        End If
    Next critério
    
    ' Desativar o filtro
    planilha.AutoFilterMode = False
End Sub

99 – Pesquisar e colar em outra planilha palavras repetidas

Sub EncontrarPalavrasRepetidas()
    Dim planilhaOrigem As Worksheet
    Dim planilhaDestino As Worksheet
    Dim celulaOrigem As Range
    Dim celulaDestino As Range
    Dim palavra As String
    Dim encontrada As Boolean
    
    ' Definir planilhas de origem e destino
    Set planilhaOrigem = ThisWorkbook.Sheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha de origem
    Set planilhaDestino = ThisWorkbook.Sheets("Planilha2") ' Substitua "Planilha2" pelo nome da sua planilha de destino
    
    ' Limpar conteúdo da planilha de destino antes de colar
    planilhaDestino.Cells.Clear
    
    ' Percorrer todas as células na planilha de origem
    For Each celulaOrigem In planilhaOrigem.UsedRange
        palavra = celulaOrigem.Value
        encontrada = False
        
        ' Verificar se a palavra já foi encontrada na planilha de destino
        For Each celulaDestino In planilhaDestino.UsedRange
            If celulaDestino.Value = palavra Then
                encontrada = True
                Exit For
            End If
        Next celulaDestino
        
        ' Se a palavra não foi encontrada, adicioná-la na próxima linha da planilha de destino
        If Not encontrada And palavra <> "" Then
            planilhaDestino.Cells(planilhaDestino.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = palavra
        End If
    Next celulaOrigem
End Sub

100 – Mesclar células de uma planilha

Sub MesclarCelulasComComentarios()
    ' Definir a planilha de destino
    Dim planilha As Worksheet
    Set planilha = ThisWorkbook.Sheets("Planilha1") ' Substitua "Planilha1" pelo nome da sua planilha

    ' Mesclar células e adicionar comentários
    With planilha
        ' Mesclar células
        .Range("A1:B2").Merge ' Substitua "A1:B2" pelo intervalo que você deseja mesclar
        
        ' Adicionar conteúdo à célula mesclada
        .Range("A1").Value = "Células Mescladas"
        
        ' Adicionar comentário à célula mesclada
        .Range("A1").AddComment "Essas células foram mescladas para destacar informações importantes."
    End With
End Sub

Tags: 100 | automatizar | código | colar | copiar | formulário. fórmula | macro | recortar | sistema | unir | vba