AW: Nachfrage
05.10.2007 11:01:58
Chaos
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