Divida a planilha do Excel em vários arquivos com base na coluna usando o VBA

Você tem um big data na planilha do excel e precisa distribuir essa planilha em várias planilhas, com base em alguns dados em uma coluna? Esta tarefa muito básica, mas demorada.

Por exemplo, eu tenho esses dados. Esses dados têm uma coluna chamada Data, Escritor e Título. A coluna do escritor tem o nome do escritor com o respectivo título. Quero obter os dados de cada escritor em folhas separadas.

Para fazer isso manualmente, tenho que fazer o seguinte:

Filtre um nome
Copie os dados filtrados
Adicionar uma folha
Cole os dados
Renomear a planilha
Repita todos os 5 passos acima para cada um.

Neste exemplo, tenho apenas três nomes. Imagine se você tivesse centenas de nomes. Como você dividiria os dados em planilhas diferentes? Isso vai levar muito tempo e vai esgotar você também.
Para automatizar o processo acima de divisão da planilha em várias planilhas, siga estas etapas.

Pressione Alt + F11. Isso abrirá o Editor VB para Excel
Adicionar um novo módulo
Copiar abaixo do código no módulo.

 Sub SplitIntoSheets () With Application .ScreenUpdating = False .DisplayAlerts = False End With ThisWorkbook.Activate Sheet1.Activate 'limpar filtro se houver On Error Resume Next Sheet1.ShowAllData On Error GoTo 0 Dim lsrClm As Long Dim lstRow As Long' contando a última linha usada lstRow = Células (Rows.Count, 1) .End (xlUp) .Row Dim uniques As Range Dim clm As String, clmNo As Long On Erro GoTo handler clm = Application.InputBox ("De qual coluna você deseja criar arquivos" & vbCrLf & "Por exemplo A, B, C, AB, ZA etc. ") clmNo = Range (clm &" 1 "). Conjunto de colunas uniques = Range (clm &" 2: "& clm & lstRow) 'Calling Remove Duplicates to Get Unique Names Set uniques = RemoveDuplicates (uniques) Chame CreateSheets (uniques, clmNo) With Application .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With Sheet1.Activate MsgBox "Muito bem!" Exit Sub Data.ShowAllData handler: With Application .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With End Sub Função RemoveDuplicates (uniques As Range) As Range ThisWorkbook.Activate Sheets.Add On Error Resume Next ActiveSheet.Name = "uniques" Sheets ("uniques"). Ative On Error GoTo 0 uniques.Copy Cells (2, 1) .Activate ActiveCell.PasteSpecial xlPasteValues Range ("A1") .Value = "uniques" Dim lstRow As Long lstRow = Cells (Rows.Count, 1) .End (xlUp) .Row Range ("A2: A" & lstRow) .Select ActiveSheet.Range (Selection.Address) .RemoveDuplicates Columns : = 1, Cabeçalho: = xlNo lstRow = Cells (Rows.Count, 1) .End (xlUp) .Row Set RemoveDuplicates = Range ("A2: A" & lstRow) End Function Sub CreateSheets (uniques As Range, clmNo As Long) Dim lstClm As Long Dim lstRow As Long For Each Unique In uniques Sheet1.Activate lstRow = Cells (Rows.Count, 1) .End (xlUp) .Row lstClm = Cells (1, Columns.Count) .End (xlToLeft) .Column Dim dataSet As Range Set dataSet = Range (Cells (1, 1), Cells (lstRow, lstClm)) dataSet.AutoFilter campo: = clmNo, Criteria1: = unique.Value lstRow = Cells (Rows.Count, 1) .End ( xlUp) .Row lstClm = Cells (1, Columns.Count) .End (xlToLeft) .Column Debug.Print lstRow; lstClm Definir dataSet = Range (Cells (1, 1), Cells (lstRow, lstClm)) dataSet.Copy Sheets.Add ActiveSheet.Name = unique.Value2 ActiveCell.PasteSpecial xlPasteAll Next unique End Sub

Quando você vai correr SplitIntoSheets () procedimento, a folha será dividida em várias folhas, com base em determinada coluna. Você pode adicionar o botão na planilha e atribuir esta macro a ele.

Como funciona
O código acima possui dois procedimentos e uma função. Dois procedimentos são SplitIntoSheets (), CreateSheets (únicos como intervalo, clmNo As Long) e uma função é RemoveDuplicates (uniques As Range) As Range.

O primeiro procedimento é SplitIntoSheets (). Este é o procedimento principal. Este procedimento define as variáveis e RemoveDuplicates para obter nomes exclusivos de determinada coluna e, em seguida, passa esses nomes para CreateSheets para a criação de planilhas.

RemoveDuplicates recebe um argumento que é o intervalo que contém o nome. Remove duplicatas deles e retorna um objeto de intervalo que contém nomes exclusivos.

Agora CreateSheets é chamado. São necessários dois argumentos. Primeiro, os nomes exclusivos e, em seguida, o número da coluna. a partir do qual iremos fitler dados. Agora CreateSheets pega cada nome de únicos e filtra o número de coluna fornecido por cada nome. Copia os dados filtrados, adiciona uma planilha e cola os dados lá. E seus dados são divididos em planilhas diferentes em segundos.

Você pode baixar o arquivo aqui.
Dividir em folhas

Como usar o arquivo:

- Copie seus dados na Folha1. Certifique-se de que começa em A1.

- Clique no botão Dividir em Folhas
- Insira a letra da coluna da qual deseja dividir. Clique OK.

- Você verá um prompt como este. Sua planilha está dividida.

Espero que o artigo sobre a divisão de dados em planilhas separadas tenha sido útil para você. Se você tiver alguma dúvida sobre este ou qualquer outro recurso do excel, fique à vontade para perguntar na seção de comentários abaixo.