AW: Alle Excel D. in einem Ordner in eine Excel D.
15.10.2005 10:42:35
Rolf
Hallo Sven,
hier mal ein konkreter Ablauf,
der jeweils das erste Arbeitsblatt der Datei
in die "große Mappe" kopiert.
Probleme kann's geben, bei zu langen Dateinamen,
Ereignisprozeduren und Verweisen.
fG
Rolf
Option Explicit
'Startprozedur
Sub start_copy_sheets()
Dim verz As String
verz = GetOrdner
ChDir verz
Application.ScreenUpdating = False
ShowFileList (verz)
End Sub
'Excel-Dateien öffnen
Sub ShowFileList(folderspec)
Dim exapp As Object
Dim fs, f, fc, fl As Object
Dim quellbereich As Range
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each fl In fc
If fl.Type = "Microsoft Excel-Arbeitsblatt" Then
Set exapp = GetObject(folderspec & "\" & fl.Name)
exapp.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = fl.Name
Call schliessen(fl.Name)
End If
Next
End Sub
'Schließprozedur
Sub schliessen(wind)
Windows(wind).Visible = True
Application.DisplayAlerts = False
Workbooks(wind).Close
End Sub
'Ordnerauswahl
Function GetOrdner(Optional ByVal def = "")
Dim objShell As Object, objfolder As Object
Set objShell = CreateObject("Shell.Application")
Set objfolder = objShell.BrowseForFolder(0, "Bitte einen Ordner wählen", 0, def)
If objfolder Is Nothing Then End
GetOrdner = objfolder.Self.Path
End Function