Suche von Tabellen mit best. Tabellenblättern -VBA

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub DateiListe() Dim FSO As Object, oFolder As Object, oFiles As Object, oFile As Object Dim strFolder As String, wks As Worksheet, wkb As Workbook With Application.FileDialog(4) '1=Open; 2=SaveAs; 3=FilePicker; 4=FolderPicker .AllowMultiSelect = False .InitialFileName = "c:\" .InitialView = 2 '1=Liste; 2=Details; 3=properties; 4=Preview; 5=Thumbnail; 6=LargeIcons; _ 7=SmallIcons .Title = "Bitte einen Ordner wählen" If .Show = -1 Then strFolder = .SelectedItems(1) End If End With If strFolder = "" Then Exit Sub Set FSO = CreateObject("Scripting.FileSystemObject") Set oFolder = FSO.getfolder(strFolder) Set oFiles = oFolder.Files For Each oFile In oFiles If oFile.Name Like "*.xls" Then Set wkb = Workbooks.Open(oFile) For Each wks In Worksheets If wks.Name = "Summen" Then 'anpassen ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = oFile End If Next wks wkb.Close False End If Next oFile End Sub

Hallo,
einfach so:


Sub DateiListe()
Dim FSO As Object, oFolder As Object, oFiles As Object, oFile As Object
Dim strFolder As String, wks As Worksheet, wkb As Workbook
With Application.FileDialog(4)   '1=Open; 2=SaveAs; 3=FilePicker; 4=FolderPicker
.AllowMultiSelect = False
.InitialFileName = "c:\"
.InitialView = 2 '1=Liste; 2=Details; 3=properties; 4=Preview; 5=Thumbnail; 6=LargeIcons;  _
_
7=SmallIcons
.Title = "Bitte einen Ordner wählen"
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then GoTo exit_sub
On Error GoTo exit_sub
Application.EnableEvents = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.getfolder(strFolder)
Set oFiles = oFolder.Files
For Each oFile In oFiles
If oFile.Name Like "*.xls" Then
Set wkb = Workbooks.Open(oFile, ignorereadonlyrecommended:=True)
For Each wks In Worksheets
If wks.Name = "Summen" Then   'anpassen
ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = oFile
End If
Next wks
wkb.Close False
End If
Next oFile
exit_sub:
Application.EnableEvents = True
End Sub

Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Set wkb = Workbooks.Open(oFile, ignorereadonlyrecommended:=True) For Each wks In Worksheets If wks.Name = "Summen" Then 'anpassen ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = oFile End If Next wks

Beliebteste Forumthreads (12 Monate)

Suche von Tabellen mit best. Tabellenblättern -VBA

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Suche von Tabellen mit best. Tabellenblättern -VBA

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread