VBA-Programmierung in Microsoft Excel

Tutorial: Excel-Beispiele

Daten aus allen Dateien eines Verzeichnisses zusammenführen

Gruppe

Allgemein

Bereich

Interaktion

Thema

Daten aus allen Dateien eines Verzeichnisses zusammenführen

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

    


Beiträge aus dem Excel-Forum zu den Themen Allgemein und Interaktion