Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Daten aus allen Dateien eines Verzeichnisses zusammenführen

Gruppe

Interaktion

Problem

Wie kann ich die Daten der aktiven Tabelle aller Arbeitsmappen eines Verzeichnisses unter Ausschluß der Zeilen 1:6 zusammenführen?

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

StandardModule: basMain

Sub Zusammenfuehren()
   Dim wksTarget As Worksheet
   Dim arr As Variant
   Dim iCounter As Integer, iRowS As Integer, iRowT As Integer
   Dim sPath As String, sPattern As String
   Application.ScreenUpdating = False
   Workbooks.Add
   Set wksTarget = Worksheets(1)
   Range("A1") = "Datenimport"
   Range("A1").Font.Bold = True
   sPath = ThisWorkbook.Path
   sPattern = "Test*.xls"
   arr = arrAll(sPath, sPattern)
   For iCounter = 1 To UBound(arr)
      Workbooks.Open arr(iCounter)
      iRowS = Cells(Rows.Count, 3).End(xlUp).Row
      iRowT = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 2
      With wksTarget.Cells(iRowT, 1)
         .Value = arr(iCounter) & ":"
         .Font.Bold = True
      End With
      iRowT = iRowT + 2
      Rows("7:" & iRowS).Copy wksTarget.Cells(iRowT, 1)
      Application.DisplayAlerts = False
      ActiveWorkbook.Close savechanges:=False
      Application.DisplayAlerts = True
   Next iCounter
   Columns.AutoFit
End Sub

Function arrAll(sPath As String, sPattern As String) As Variant
   Dim arr()
   Dim iCounter As Integer
   Dim sFile As String
   If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
   sFile = Dir(sPath & sPattern)
   Do While sFile <> ""
      iCounter = iCounter + 1
      ReDim Preserve arr(1 To iCounter)
      arr(iCounter) = sFile
      sFile = Dir()
   Loop
   arrAll = arr
End Function