Kopieren Sie einen Bereich aus jeder Arbeitsmappe in einem Ordner mit VBA in Microsoft Excel
einen Bereich aus jeder Arbeitsmappe in einen Ordner In diesem Artikel erstellen wir ein Makro zum Kopieren von Daten aus mehreren Arbeitsmappen in einem Ordner in eine neue Arbeitsmappe.
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 in diese.
Die Rohdaten für dieses Beispiel bestehen aus Anwesenheitslisten der Mitarbeiter.
Im TestFolder haben wir mehrere Excel-Dateien. Dateinamen von Excel-Dateien repräsentieren ein bestimmtes Datum im Format „TTMJJJJ“.
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 ausgeführt werden, indem Sie auf die Schaltfläche „Copying Single Column“ klicken. Das Makro „CopyingMultipleColumnData“ kann ausgeführt werden, indem Sie auf die Schaltfläche „Kopieren mehrerer Spalten“ klicken.
Vor dem Ausführen des Makros muss der Pfad des Ordners im Textfeld angegeben werden, in dem Excel-Dateien abgelegt werden.
Wenn Sie auf die Schaltfläche „Einzelne Spalte kopieren“ klicken, wird im definierten Ordner eine neue Arbeitsmappe „ConsolidatedFile“ generiert. Diese Arbeitsmappe enthält konsolidierte Daten aus der ersten Spalte aller Dateien im Ordner.
Die neue Arbeitsmappe wird erstellt Enthält nur Datensätze in der ersten Spalte. Sobald wir die konsolidierten Daten haben, können wir die Anzahl der an einem bestimmten Tag anwesenden Mitarbeiter ermitteln, indem wir die Anzahl der Daten zählen. Die Anzahl eines bestimmten Datums entspricht der Anzahl der an diesem bestimmten Tag anwesenden Mitarbeiter Tag.
Wenn Sie auf die Schaltfläche „Kopieren mehrerer Spalten“ klicken, wird die neue Arbeitsmappe „ConsolidatedAllColumns“ im definierten Ordner generiert. 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 wir die konsolidierten Daten haben, haben wir alle Anwesenheitsdetails in einer einzigen Datei verfügbar. Wir können leicht die Anzahl der an diesem bestimmten Tag anwesenden Mitarbeiter ermitteln und auch die Namen der Mitarbeiter abrufen, die an diesem bestimmten Tag anwesend waren.
Code Erklärung
Sheet1.TextBox1.Value Der obige Code wird verwendet, um den in das Textfeld „TextBox1“ eingefügten Wert aus dem Blatt „Sheet1“ abzurufen.
Dir (FolderPath & „* .xlsx“)
Der obige Code wird verwendet, um den Namen der Datei mit der Dateierweiterung „.xlsx“ abzurufen. Wir haben Platzhalter * für Dateinamen mit mehreren Zeichen verwendet.
Während FileName <> „“
Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1)
FileArray (Count1) = FileName FileName = Dir ()
Wend Der obige Code wird verwendet, um Dateinamen aller Dateien im Ordner abzurufen.
Für i = 1 To UBound (FileArray)
Weiter Der obige Code wird verwendet, um alle Dateien im Ordner zu durchlaufen.
Bereich („A1“, Zellen (LastRow, 1)). Kopieren Sie DestWB.ActiveSheet.Cells (LastDesRow, 1)
Der obige Code wird verwendet, um den Datensatz aus der ersten Spalte in die Zielarbeitsmappe zu kopieren.
Bereich („A1“, ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopieren Sie 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()
'Declaring variables
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
'Inserting backslash in the folder path if backslash(\) is missing
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
'Searching for Excel files
FileName = Dir(FolderPath & "*.xlsx")
Count1 = 0
'Looping through all the Excel files in the folder
While FileName <> ""
Count1 = Count1 + 1
ReDim Preserve FileArray(1 To Count1)
FileArray(Count1) = FileName
FileName = Dir()
Wend
'Creating a new workbook
Set DestWB = Workbooks.Add
For i = 1 To UBound(FileArray)
'Finding the last row in the workbook
LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row
'Opening the Excel workbook
Set SourceWB = Workbooks.Open(FolderPath & FileArray(i))
LastRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
'Pasting the copied data to last row in the destination workbook
If LastDesRow = 1 Then
'Copying the first column to last row in the destination workbook
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
'Saving and closing a new Excel workbook
DestWB.SaveAs FileName:=FolderPath & "ConsolidatedFile.xlsx"
DestWB.Close
Set DestWB = Nothing
Set SourceWB = Nothing
End Sub
Sub CopyingMultipleColumnData()
'Declaring variables
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
'Inserting backslash in the folder path if backslash(\) is missing
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
'Searching for Excel files
FileName = Dir(FolderPath & "*.xlsx")
Count1 = 0
'Looping through all the Excel files in the folder
While FileName <> ""
Count1 = Count1 + 1
ReDim Preserve FileArray(1 To Count1)
FileArray(Count1) = FileName
FileName = Dir()
Wend
'Creating a new workbook
Set DestWB = Workbooks.Add
For i = 1 To UBound(FileArray)
'Finding the last row in the workbook
LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row
'Opening the Excel workbook
Set SourceWB = Workbooks.Open(FolderPath & FileArray(i))
'Pasting the copied data to last row in the destination workbook
If LastDesRow = 1 Then
'Copying all data in the worksheet to last row in the destination workbook
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
'Saving and closing a new Excel workbook
DestWB.SaveAs FileName:=FolderPath & "ConsolidatedAllColumns.xlsx"
DestWB.Close
Set DestWB = Nothing
Set SourceWB = Nothing
End Sub
Wenn Ihnen dieser Blog gefallen hat, teilen Sie ihn mit Ihren Freunden auf Facebook und Facebook.
Wir würden gerne von Ihnen hören, lassen Sie uns wissen, wie wir unsere Arbeit verbessern und für Sie verbessern können. Schreiben Sie uns unter [email protected]