Microsoft Excel

Herbers Excel/VBA-Archiv

Zusammenfasseung von Excel Tabellen

Betrifft: Zusammenfasseung von Excel Tabellen von: Iditzje
Geschrieben am: 05.10.2007 08:19:03

Hallo,

ich möchte aus 192 einzelnen Excel Tabellen eine machen, damit ich sogenannte Auswertungen machen kann.

Wer kann mir sagen, wie das am schnellsten geht????????

Gruß

  

Betrifft: AW: Nachfrage von: Chaos
Geschrieben am: 05.10.2007 09:13:22

Servus,

wie schauen die Tabellen aus ? Alle gleich, oder sind die total unterschiedlich?

das Einfachste ist: alle Dateien in einen Ordner kopieren, diese nacheinander per Makro öffnen lassen, die gewünschten Bereiche in die Zieldatei kopieren, die Quelldatei wieder schließen und dann auswerten.

Gruß

Chaos


  

Betrifft: AW: Nachfrage von: Iditzje
Geschrieben am: 05.10.2007 10:19:52

Hi,

kannst du mir bitte diesen Weg (alle Dateien in einen Ordner kopieren, diese nacheinander per Makro öffnen lassen, die gewünschten Bereiche in die Zieldatei kopieren, die Quelldatei wieder schließen und dann auswerten) beschreiben wie das geht?
Zur Info: die Tabellen sind in der Anzahl der Spalten gleich, jedoch nicht in der Anzahl der Zeilen.

Gruß


  

Betrifft: AW: Nachfrage von: Chaos
Geschrieben am: 05.10.2007 11:01:58

Servus,

Sub öffnen_zusammenfügen()
Dim Dateiname As String, Dateipfad As String, pfad As String, ZielName As String
Dim Dateien As Integer
ZielName = ThisWorkbook.Name
pfad = "C:\..." ' Hier der Dateipfad, wo die 192 Dateien sind
Application.ScreenUpdating = False
With Application.FileSearch
   On Error Resume Next
  .NewSearch
  .LookIn = pfad
  .Filename = "*" & ".xls" ' öffnet alle Dateien, egal welcher Name
     If .Execute() > 0 Then
         For Dateien = 1 To .FoundFiles.Count ' Schleife, um jede Datei zu öffnen und das u.a.  _
auszuführen
             Dateiname = Dir(.FoundFiles(Dateien))
             Dateipfad = .FoundFiles(Dateien)
             If Dateiname <> ThisWorkbook.Name Then
                Workbooks.Open Filename:=.FoundFiles(Dateien)
                Dim letzte As Long
                letzte = Workbooks(Dateiname).Sheets(1).Range("A65536").End(xlUp).Row ' sucht  _
die letzte Zeile in der Quelldatei
                Workbooks(Dateiname).Sheets(1).Range("A1:C" & letzte).Copy Workbooks(ZielName). _
Sheets(1).Range("A65536").End(xlUp).Offset(0, 0) ' kopiert den Bereich A1 : C und letzte Zeile aus der Quelldatei Sheet1 in die erste freie Zeile in Sheet1 in der Zieldatei
                Workbooks(Dateiname).Close ' schließt die Quelldatei
             End If
         Next
      End If
   End With
   Workbooks(ZielName).Save
   Application.ScreenUpdating = True
End Sub



Das Makro öffnet alle Dateien und kopiert aus Sheet(1), das ist das erste Sheet in der Arbeitsmappe, den Bereich A1: C und letzte beschriebene Zeile (musst du auf deine Spalten anpassen, also statt C z.B. H) in die Zieldatei, in der auch das Makro steht.

Das Verschieben der 192 Dateien in einen Ordner wirst du ja wohl alleine hinbekommen, ist halt etwas Arbeit.

Ich hab den Code ein wenig auskommentiert.

Gruß

Chaos


 

Beiträge aus den Excel-Beispielen zum Thema "Zusammenfasseung von Excel Tabellen"