Teilen Sie ein Excel-Blatt in mehrere Dateien basierend auf einer Spalte mit VBA auf

Haben Sie große Datenmengen auf Excel-Tabellen und müssen diese Tabelle basierend auf einigen Daten in einer Spalte auf mehrere Tabellenblätter verteilen? Diese sehr grundlegende Aufgabe, aber zeitaufwendig.

Ich habe zum Beispiel diese Daten. Diese Daten haben eine Spalte namens Datum, Autor und Titel. Die Spalte "Autor" enthält den Namen des Autors des jeweiligen Titels. Ich möchte die Daten jedes Autors in separaten Blättern haben.

Um dies manuell zu tun, muss ich Folgendes tun:

Einen Namen filtern
Kopieren Sie die gefilterten Daten
Blatt hinzufügen
Fügen Sie die Daten ein
Benennen Sie das Blatt um
Wiederholen Sie alle oben genannten 5 Schritte für jeden.

In diesem Beispiel habe ich nur drei Namen. Stellen Sie sich vor, Sie hätten Hunderte von Namen. Wie würden Sie Daten in verschiedene Blätter aufteilen? Es wird viel Zeit in Anspruch nehmen und wird Sie auch auslaugen.
Führen Sie die folgenden Schritte aus, um den obigen Vorgang zum Aufteilen eines Blatts in mehrere Blätter zu automatisieren.

Drücken Sie Alt+F11. Dadurch wird der VB-Editor für Excel geöffnet
Ein neues Modul hinzufügen
Kopieren Sie den folgenden Code in das Modul.

 UnterteilenIntoSheets() With Application .ScreenUpdating = False .DisplayAlerts = False End With ThisWorkbook.Activate Sheet1.Activate 'Filter löschen, falls vorhanden Bei Fehler Resume Next Sheet1.ShowAllData On Error GoTo 0 Dim lsrClm As Long Dim lstRow As Long 'Zählen der zuletzt verwendeten Zeile lstRow = Zellen (Rows.Count, 1).End(xlUp).Row Dim uniques As Range Dim clm As String, clmNo As Long On Error GoTo-Handler clm = Application.InputBox("Aus welcher Spalte sollen Dateien erstellt werden" & vbCrLf & "Eg A,B,C,AB,ZA usw.") clmNo = Range(clm & "1").Column Set uniques = Range(clm & "2:" & clm & lstRow) 'Aufruf von Duplikaten entfernen, um eindeutige Namenssätze zu erhalten uniques = RemoveDuplicates(uniques) Aufruf CreateSheets(uniques, clmNo) mit Anwendung .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic Ende mit Sheet1.Activate MsgBox "Gut gemacht!" Exit Sub Data.ShowAllData Handler: Mit Anwendung .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With End Sub Funktion RemoveDuplicates (eindeutige als Bereich) als Bereich 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 (eindeutig als Bereich, clmNo As Long) Dim lstClm As Long Dim lstRow As Long für jedes eindeutige 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

Wenn du läufst SplitIntoSheets() wird das Blatt basierend auf der angegebenen Spalte in mehrere Blätter unterteilt. Sie können dem Blatt eine Schaltfläche hinzufügen und diesem dieses Makro zuweisen.

Wie es funktioniert
Der obige Code hat zwei Prozeduren und eine Funktion. Zwei Verfahren sind SplitIntoSheets(), CreateSheets (eindeutig als Bereich, clmNo As Long) und eine Funktion ist RemoveDuplicates(Uniques As Range) As Range.

Erstes Verfahren ist SplitIntoSheets(). Dies ist das Hauptverfahren. Dieses Verfahren setzt die Variablen und Duplikate entfernen um eindeutige Namen aus einer bestimmten Spalte zu erhalten und diese Namen dann an . weiterzugeben Tabellen erstellen zum Erstellen von Blättern.

Duplikate entfernen nimmt ein Argument an, das range ist, das name enthält. Entfernt Duplikate von ihnen und gibt ein Bereichsobjekt zurück, das eindeutige Namen enthält.

Jetzt Tabellen erstellen wird genannt. Es braucht zwei Argumente. Zuerst die eindeutigen Namen und zweitens die Spalten-Nr. von denen wir es fitler Daten werden. Jetzt Tabellen erstellen nimmt jeden Namen von Uniques und filtert die angegebene Spaltennummer nach jedem Namen. Kopiert die gefilterten Daten, fügt ein Blatt hinzu und fügt die Daten dort ein. Und Ihre Daten werden in Sekundenschnelle in verschiedene Blätter aufgeteilt.

Sie können die Datei hier herunterladen.
In Blätter aufteilen

So verwenden Sie die Datei:

- Kopieren Sie Ihre Daten auf Sheet1. Stellen Sie sicher, dass es bei A1 beginnt.

- Klicken Sie auf die Schaltfläche In Blätter aufteilen
- Geben Sie den Spaltenbuchstaben ein, von dem Sie trennen möchten. OK klicken.

- Sie sehen eine Aufforderung wie diese. Ihr Blatt ist geteilt.

Ich hoffe, der Artikel über das Aufteilen von Daten in separate Blätter war hilfreich für Sie. Wenn Sie Zweifel an dieser oder einer anderen Funktion von Excel haben, können Sie dies im Kommentarbereich unten fragen.