Excel feuille de Split en plusieurs fichiers basés sur colonne en utilisant VBA
Avez-vous un big data sur une feuille Excel et vous devez distribuer cette feuille en plusieurs feuilles, en fonction de certaines données dans une colonne? Cette tâche très basique mais qui prend du temps.
Par exemple, j’ai ces données. Ces données ont une colonne nommée Date, Writer et Title. La colonne Writer a le nom de l’auteur du titre respectif. Je souhaite obtenir les données de chaque rédacteur dans des feuilles séparées.
Pour faire cela manuellement, je dois faire ce qui suit:
-
Filtrez un nom. Copiez les données filtrées. Ajoutez une feuille. Collez les données. Renommez la feuille. Répétez les 5 étapes ci-dessus pour chacune.
Dans cet exemple, je n’ai que trois noms. Imaginez si vous avez des centaines de noms.
Comment diviseriez-vous les données en différentes feuilles? Cela prendra beaucoup de temps et vous épuisera aussi.
Pour automatiser le processus ci-dessus de division de la feuille en plusieurs feuilles, procédez comme suit.
Appuyez sur Alt + F11. Cela ouvrira l’éditeur VB pour Excel Ajouter un nouveau module * Copier le code ci-dessous dans le module.
Sub SplitIntoSheets()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
ThisWorkbook.Activate
Sheet1.Activate
'clearing filter if any
On Error Resume Next
Sheet1.ShowAllData
On Error GoTo 0
Dim lsrClm As Long
Dim lstRow As Long
'counting last used row
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim uniques As Range
Dim clm As String, clmNo As Long
On Error GoTo handler
clm = Application.InputBox("From which column you want create files" & vbCrLf & "E.g. A,B,C,AB,ZA etc.")
clmNo = Range(clm & "1").Column
Set uniques = Range(clm & "2:" & clm & lstRow)
'Calling Remove Duplicates to Get Unique Names
Set uniques = RemoveDuplicates(uniques)
Call CreateSheets(uniques, clmNo)
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.AlertBeforeOverwriting = True
.Calculation = xlCalculationAutomatic
End With
Sheet1.Activate
MsgBox "Well Done!"
Exit Sub
Data.ShowAllData
handler:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.AlertBeforeOverwriting = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Function RemoveDuplicates(uniques As Range) As Range
ThisWorkbook.Activate
Sheets.Add
On Error Resume Next
ActiveSheet.Name = "uniques"
Sheets("uniques").Activate
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, Header:=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 field:=clmNo, Criteria1:=unique.Value
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
lstClm = Cells(1, Columns.Count).End(xlToLeft).Column
Debug.Print lstRow; lstClm
Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm))
dataSet.Copy
Sheets.Add
ActiveSheet.Name = unique.Value2
ActiveCell.PasteSpecial xlPasteAll
Next unique
End Sub
Lorsque vous exécutez la procédure SplitIntoSheets (), la feuille est divisée en plusieurs feuilles, en fonction de la colonne donnée. Vous pouvez ajouter un bouton sur la feuille et lui attribuer cette macro.
Comment ça marche
Le code ci-dessus a deux procédures et une fonction. Deux procédures sont SplitIntoSheets (), CreateSheets (uniques As Range, clmNo As Long) et une fonction est RemoveDuplicates (uniques As Range) As Range. La première procédure est SplitIntoSheets (). C’est la procédure principale. Cette procédure définit les variables et RemoveDuplicates pour obtenir des noms uniques de la colonne donnée, puis transmet ces noms à CreateSheets pour créer des feuilles.
RemoveDuplicates prend un argument qui est la plage qui contient le nom.
Supprime les doublons et renvoie un objet de plage contenant des noms uniques.
Maintenant, CreateSheets est appelé. Cela prend deux arguments. D’abord les noms uniques et ensuite la colonne no. à partir de laquelle nous allons adapter les données. Maintenant, CreateSheets prend chaque nom parmi les uniques et filtre le numéro de colonne donné par chaque nom. Copie les données filtrées, ajoute une feuille et collez-y les données. Et vos données sont divisées en différentes feuilles en quelques secondes.
Vous pouvez télécharger le fichier ici.
Diviser en feuilles
Comment utiliser le fichier:
-
Copiez vos données sur Sheet1. Assurez-vous qu’il commence à partir de A1.
Cliquez sur le bouton Split into Sheets * Entrez la lettre de la colonne à partir de laquelle vous souhaitez fractionner. Cliquez sur OK.
-
Vous verrez une invite comme celle-ci. Votre feuille est divisée.
J’espère que l’article sur la division des données en feuilles séparées vous a été utile. Si vous avez des doutes à ce sujet ou sur toute autre fonctionnalité d’Excel, n’hésitez pas à le poser dans la section commentaires ci-dessous.