AW: Aus mehreren xls-Dateien eine machen
03.08.2005 09:05:59
Hajo_Zi
Hallo Mirko,
es wird immer nur aus der Activen Tabelle kopiert. Als es werden bei den geöffneten Dateien nicht alle Tabellen durchgegangen.
Option Explicit
Sub Datei_kopieren()
' erstellt von Hajo.Ziplies@web.de
' <a href="http://home.media-n.de/ziplies/">http://home.media-n.de/ziplies/</a>
' alle Dateien eines Ordners öffnen
Dim strVerzeichnis As String
Dim StrDatei As String
Dim StrTyp As String
Dim Dateiname As String
Dim LoLetzte As Long
Dim LoLetzte2 As Long
strVerzeichnis = "D:\Eigene Dateien\Hajo\"
StrTyp = "*.xls"
Dateiname = Dir(strVerzeichnis & StrTyp)
Do While Dateiname <> ""
Workbooks.Open Filename:=strVerzeichnis & Dateiname
With ThisWorkbook.ActiveSheet
LoLetzte2 = IIf(IsEmpty(.Range("A65536")), .Range("A65536").End(xlUp).Row, 65536)
LoLetzte = IIf(IsEmpty(Range("A65536")), Range("A65536").End(xlUp).Row, 65536)
ActiveSheet.Range(Cells(1, 1), Cells(LoLetzte, 1)).Copy .Cells(LoLetzte2 + 1, 1)
End With
ActiveWorkbook.Close True
Dateiname = Dir
Loop
End Sub
Bitte keine Mail, Probleme sollten im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Betriebssystem XP Home SP2 und Excel Version 2003 SP1.