In diesem Artikel erstellen wir ein Makro, um Daten aus mehreren Arbeitsmappen in einem Ordner in eine neue Arbeitsmappe zu kopieren.
Wir werden zwei Makros erstellen; Ein Makro kopiert nur Datensätze aus der ersten Spalte in die neue Arbeitsmappe und das zweite Makro kopiert alle Daten hinein.
Rohdaten für dieses Beispiel bestehen aus Anwesenheitsaufzeichnungen von Mitarbeitern. Im TestFolder haben wir mehrere Excel-Dateien. Dateinamen von Excel-Dateien repräsentieren ein bestimmtes Datum im Format „TTMMJJJJ“.
Jede Excel-Datei enthält Datum, Mitarbeiter-ID und Mitarbeiternamen der Mitarbeiter, die an diesem bestimmten Tag anwesend waren.
Wir haben zwei Makros erstellt; „CopyingSingleColumnData“ und „CopyingMultipleColumnData“. Das Makro "CopyingSingleColumnData" kopiert nur Datensätze aus der ersten Spalte aller Dateien im Ordner in die neue Arbeitsmappe. Das Makro "CopyingMultipleColumnData" kopiert alle Daten aus allen Dateien im Ordner in die neue Arbeitsmappe.
Das Makro „CopyingSingleColumnData“ kann durch Klicken auf die Schaltfläche „Copying Single Column“ ausgeführt werden. Das Makro „CopyingMultipleColumnData“ kann durch Klicken auf die Schaltfläche „Copying Multiple Columns“ ausgeführt werden.
Bevor Sie das Makro ausführen, müssen Sie den Pfad des Ordners im Textfeld angeben, in dem die Excel-Dateien abgelegt werden.
Wenn Sie auf die Schaltfläche "Einzelne Spalte kopieren" klicken, wird eine neue Arbeitsmappe "ConsolidatedFile" im definierten Ordner erstellt. Diese Arbeitsmappe enthält konsolidierte Daten aus der ersten Spalte aller Dateien im Ordner.
Die neue Arbeitsmappe enthält nur Datensätze in der ersten Spalte. Sobald uns die konsolidierten Daten vorliegen, können wir die Anzahl der an einem bestimmten Tag anwesenden Mitarbeiter durch Zählen der Datumsangaben ermitteln. Die Anzahl eines bestimmten Datums entspricht der Anzahl der an diesem bestimmten Tag anwesenden Mitarbeiter.
Wenn Sie auf die Schaltfläche "Mehrere Spalten kopieren" klicken, wird die neue Arbeitsmappe "ConsolidatedAllColumns" im definierten Ordner erstellt. Diese Arbeitsmappe enthält konsolidierte Daten aus allen Datensätzen aller Dateien im Ordner.
Die neu erstellte Arbeitsmappe enthält alle Datensätze aus allen Dateien im Ordner. Sobald uns die konsolidierten Daten vorliegen, stehen uns alle Anwesenheitsdetails in einer einzigen Datei zur Verfügung. Wir können leicht die Anzahl der an diesem Tag anwesenden Mitarbeiter ermitteln und erhalten auch die Namen der Mitarbeiter, die an diesem bestimmten Tag anwesend waren.
Codeerklärung
Sheet1.TextBox1.Value
Der obige Code wird verwendet, um den in das Textfeld „TextBox1“ eingefügten Wert aus dem Blatt „Sheet1“ zu erhalten.
Dir(OrdnerPfad & "*.xlsx")
Der obige Code wird verwendet, um den Namen der Datei zu erhalten, die die Dateierweiterung „.xlsx“ hat. Wir haben Platzhalter * für Dateinamen mit mehreren Zeichen verwendet.
Während Dateiname ""
Anzahl1 = Anzahl1 + 1
ReDim Preserve FileArray(1 bis Count1)
FileArray(Count1) = FileName
Dateiname = Dir()
Wende
Der obige Code wird verwendet, um die Dateinamen aller Dateien im Ordner abzurufen.
Für i = 1 an UBound(FileArray)
Nächste
Der obige Code wird verwendet, um alle Dateien im Ordner zu durchlaufen.
Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
Der obige Code wird verwendet, um den Datensatz aus der ersten Spalte in die Zielarbeitsmappe zu kopieren.
Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
Der obige Code wird verwendet, um den gesamten Datensatz aus der aktiven Arbeitsmappe in die Zielarbeitsmappe zu kopieren.
Bitte folgen Sie unten für den Code
Option Explicit Sub CopyingSingleColumnData() 'Variablen deklarieren Dim FileName, FolderPath, FileArray(), FileName1 As String Dim LastRow, LastDesRow, Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value ' Backslash in den Ordnerpfad einfügen, wenn Backslash(\) fehlt If Right(FolderPath, 1) "\" Then FolderPath = FolderPath & "\" End If 'Suche nach Excel-Dateien FileName = Dir(FolderPath & "*.xlsx") Count1 = 0 'Durchlaufen aller Excel-Dateien im Ordner While FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray(1 To Count1) FileArray(Count1) = FileName FileName = Dir() Wend 'Erstellen einer neuen Arbeitsmappe Set DestWB = Workbooks.Add For i = 1 To UBound(FileArray) 'Finden der letzten Zeile in der Arbeitsmappe LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row 'Öffnen der Excel-Arbeitsmappe Set SourceWB = Workbooks.Open (FolderPath & FileArray(i)) LastRow = ActiveCell.SpecialCells(xlCellTypeLas tCell).Row 'Einfügen der kopierten Daten in die letzte Zeile der Zielarbeitsmappe If LastDesRow = 1 Then 'Kopieren der ersten Spalte in die letzte Zeile der Zielarbeitsmappe Range("A1", Cells(LastRow, 1)).Copy DestWB. ActiveSheet.Cells(LastDesRow, 1) Else Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1) End If SourceWB.Close False Next 'Neues Excel speichern und schließen Arbeitsmappe DestWB.SaveAs FileName:=FolderPath & "ConsolidatedFile.xlsx" DestWB.Close Set DestWB = Nothing Set SourceWB = Nothing End Sub Sub CopyingMultipleColumnData() 'Variablen deklarieren Dim FileName, FolderPath, FileArray(), FileName1 als String Dim LastRow, LastDesRow , Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value 'Backslash in den Ordnerpfad einfügen, wenn Backslash(\) fehlt If Right(FolderPath, 1) "\" Then FolderPath = FolderPath & "\" End If 'Suche nach Excel-Dateien FileName = Dir(FolderPath & "*.xlsx") Count1 = 0 'Durchlaufen aller Excel-Dateien im Ordner While FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray(1 To Count1) FileArray(Count1) = FileName FileName = Dir() Wend 'Erstellen einer neuen Arbeitsmappe Set DestWB = Workbooks.Add For i = 1 To UBound(FileArray) 'Finden der letzten Zeile in der Arbeitsmappe LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row 'Öffnen der Excel-Arbeitsmappe Set SourceWB = Workbooks.Open(FolderPath & FileArray(i)) 'Einfügen der kopierten Daten in die letzte Zeile der Zielarbeitsmappe If LastDesRow = 1 Then 'Kopieren aller Daten im Arbeitsblatt in die letzte Zeile der Zielarbeitsmappe Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)). Copy DestWB.ActiveSheet.Cells(LastDesRow, 1) Else Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1) End If SourceWB.Close False Next 'Speichern und schließen eine neue Excel-Arbeitsmappe DestWB.SaveAs FileName:=FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close Set D estWB = Nichts Set SourceWB = Nichts End Sub
Wenn Ihnen dieser Blog gefallen hat, teilen Sie ihn mit Ihren Freunden auf Facebook. Außerdem können Sie uns auf Twitter und Facebook folgen.
Wir würden uns freuen, von Ihnen zu hören, lassen Sie uns wissen, wie wir unsere Arbeit verbessern und für Sie verbessern können. Schreiben Sie uns auf der E-Mail-Site