HERBERS Excel-Forum - die Beispiele

Thema: Arbeitsmappen öffnen und Bereiche kopieren

Home

Gruppe

Datei

Problem

Alle Arbeitsmappen in dem in Zelle B1 genannten Verzeichnis sollen geöffnet und der mit Zelle A1 zusammenhängende Bereich des 3. Tabellenblattes in dieses Blatt kopiert werden.

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

Sub Zusammenfassen()
   Dim wkb As Workbook
   Dim wks As Worksheet
   Dim arr As Variant
   Dim lRow As Long
   Dim iCounter As Integer
   Dim sFile As String
   Application.ScreenUpdating = False
   Application.EnableEvents = False
   On Error GoTo ERRORHANDLER
   Set wks = ActiveSheet
   sFile = Range("B1").Value
   arr = FileArray(sFile, "*.xls")
   For iCounter = 1 To UBound(arr)
      Set wkb = Workbooks.Open(sFile & "\" & _
         arr(iCounter))
      lRow = wks.Cells(Rows.Count, 1).End(xlUp).Row + 2
      wks.Cells(lRow, 1).Value = wkb.Name
      lRow = lRow + 2
      wkb.Worksheets(3).Range("A1").CurrentRegion.Copy wks.Cells(lRow, 1)
      wkb.Close savechanges:=False
   Next iCounter
   Worksheets(1).Select
ERRORHANDLER:
   Application.EnableEvents = True
   Application.ScreenUpdating = True
End Sub

Function FileArray(ByVal strPath As String, _
   sPattern As String)
   Dim arr()
   Dim iCounter As Integer
   Dim sFile As String
   If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
   sFile = Dir(strPath & sPattern)
   If sFile = "" Then
      Beep
      MsgBox "Keine Dateien gefunden!"
      End
   End If
   Do While sFile <> ""
       iCounter = iCounter + 1
       ReDim Preserve arr(1 To iCounter)
       arr(iCounter) = sFile
       sFile = Dir()
   Loop
   FileArray = arr
End Function

Beiträge aus dem Excel-Forum zu den Themen Datei und Arbeitsmappe

Excel/PDF Datei unter bestimmten Pfad abspeichern aus excel Worddatei nach Wert durchsuchen
Split-Funktion beim Einlesen TXT-Datei Datei löschen mit unterschiedlichen Zahlen im Name
Datei löschen mit unterschiedlichen Zhalen im Name geöffnete Worddatei und Word aus Excel beenden
Excel-Datei nicht im Projekt-Explorer Suche nach jüngster Datei
Mehrere Zellen in mehreren Dateien ersetzen Datei öffnen mit variablen im Namen
Vergleichen zweier Dateien und aktualisieren Datei langsam durch Formel
Dateien aus Unterordner öffnen Daten import aus txt--Datei
Variablen Übergabe an Makro (andere Arbeitsmappe) Dateipfad öffnen mit VBA
Datei-Verknüpfungen Masterdatei erschaffen?
Mehrere Datenblätter als PDF-Datei ausgeben Makro bei Erstellen einer Datei aus einer Vorlage
Zusammenführung aus mehreren Dateien Rechteck per Button in andere Datei einfügen.
Alle Dateien in einem Unterordner öffnen VBA: MsgBox: yes/no. Bei yes andere Datei öffnen
Mehrere txt Dateien einlesen in ein Programm VBA Datei als .txt speichern
Code erst nach Anzeige der Arbeitsmappe ausführen Excel Datei in CSV Datei wandeln mit Extras
aktierten Text in geöffnete Worddatei Spalte in andere Dateien kopieren + zurückkopieren
Aus einer CSV-Datei ein bestimmtes Layout erzeugen Daten ausgew. WS in 2. Datei zusammenführen
Per VBA aktuelle Datei in Autostart-Ordner csv Dateien importieren
Makrodatei als Software hochwertiger gestalten manuelles Speichern bei schreibgeschützter Datei
Daten aus geschlossener Datei in Zieldatei kopiere Dateinamen per VBA vorgeben (Datum: Vormonat)
Ordner mit Unterordnern/Dateien kopieren Auswertung über mehrere Dateien
Geschlossene Excel-Datei bearbeiten? datei öffnen durch vba ohne makroaktivierung
Datei öffnet im Entwurfsmodus Dateinamen der ausgelesenen Datei anzeigen
Dateien vergleichen-doppelte löschen Datendatei per Doppelklick einlesen
Hyperlink auf Excel-Datei funktioniert nicht Kopieren über 2 Dateien?
Dateiinfo aller Dateien in allen Verz./Unterverz