Makro gesucht

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub mehrere_arbeitsmappen_oeffnen() Dim strVerzeichnis As String Dim strTyp As String Dim strDateiname As String Dim lngZeile As Long Dim wksTab As Worksheet Dim intSpalte As Integer strTyp = "*.xlsx*" Application.ScreenUpdating = False strVerzeichnis = "D:\DeinVerzeichnis" If Right(strVerzeichnis, 1) "\" Then strVerzeichnis = strVerzeichnis & "\" strDateiname = Dir(strVerzeichnis & strTyp) lngZeile = 2 With ThisWorkbook.Worksheets("Tabelle1") Do While strDateiname "" intSpalte = 1 Workbooks.Open Filename:=strVerzeichnis & strDateiname .Cells(lngZeile, intSpalte) = ActiveWorkbook.Name intSpalte = intSpalte + 1 For Each wksTab In ActiveWorkbook.Worksheets .Cells(lngZeile, intSpalte) = wksTab.Name intSpalte = intSpalte + 1 Next wksTab ActiveWorkbook.Close False strDateiname = Dir lngZeile = lngZeile + 1 Loop End With Application.ScreenUpdating = True End Sub

Sub mehrere_arbeitsmappen_oeffnen() Dim strVerzeichnis As String Dim strTyp As String Dim strDateiname As String Dim lngZeile As Long Dim wksTab As Worksheet Dim intSpalte As Integer strTyp = "*.xlsx" Application.ScreenUpdating = False strVerzeichnis = "\\srv01088\userdaten$\Plog\Desktop\heute" If Right(strVerzeichnis, 1) "\" Then strVerzeichnis = strVerzeichnis & "\" strDateiname = Dir(strVerzeichnis & strTyp) lngZeile = 2 With ThisWorkbook.Worksheets("Tabelle1") Do While strDateiname "" intSpalte = 1 Workbooks.Open Filename:=strVerzeichnis & strDateiname .Cells(lngZeile, intSpalte) = ActiveWorkbook.Name intSpalte = intSpalte + 1 For Each wksTab In ActiveWorkbook.Worksheets .Cells(lngZeile, intSpalte) = wksTab.Name intSpalte = intSpalte + 1 Next wksTab ActiveWorkbook.Close False strDateiname = Dir lngZeile = lngZeile + 1 Loop End With Application.ScreenUpdating = True End Sub

Sub mehrere_arbeitsmappen_oeffnen() Dim strVerzeichnis As String Dim strTyp As String Dim strDateiname As String Dim lngZeile As Long Dim wksTab As Worksheet Dim intSpalte As Integer Dim anzFiles As Integer strTyp = "*.xlsx" Application.ScreenUpdating = False strVerzeichnis = "C:\DEINVERZEICHNIS" If Right(strVerzeichnis, 1) "\" Then strVerzeichnis = strVerzeichnis & "\" strDateiname = Dir(strVerzeichnis & strTyp) lngZeile = 2 anzFiles = 0 With ThisWorkbook.Worksheets("Tabelle1") Do While strDateiname "" intSpalte = 1 anzFiles = anzFiles + 1 Workbooks.Open Filename:=strVerzeichnis & strDateiname .Cells(lngZeile, intSpalte) = ActiveWorkbook.Name intSpalte = intSpalte + 1 For Each wksTab In ActiveWorkbook.Worksheets .Cells(lngZeile, intSpalte) = wksTab.Name intSpalte = intSpalte + 1 Next wksTab ActiveWorkbook.Close False strDateiname = Dir lngZeile = lngZeile + 1 Loop End With Application.ScreenUpdating = True MsgBox "Anzahl Dateien gefunden: " & anzFiles End Sub

Hallo Karin,
ich kann mir nur vorstellen, dass die geoeffneten Dateien bei dir dann nicht die aktiven Workbooks sind. Warum auch immer.
Versuch nochmal das hier:


Sub mehrere_arbeitsmappen_oeffnen()
Dim strVerzeichnis As String
Dim strTyp As String
Dim strDateiname As String
Dim lngZeile As Long
Dim wksTab As Worksheet
Dim intSpalte As Integer
Dim anzFiles As Integer
strTyp = "*.xlsx"
Application.ScreenUpdating = False
strVerzeichnis = "C:\DeinVerzeichnis"
If Right(strVerzeichnis, 1)  "\" Then strVerzeichnis = strVerzeichnis & "\"
strDateiname = Dir(strVerzeichnis & strTyp)
lngZeile = 2
anzFiles = 0
With ThisWorkbook.Worksheets("Sheet5")
Do While strDateiname  ""
intSpalte = 1
anzFiles = anzFiles + 1
Workbooks.Open FileName:=strVerzeichnis & strDateiname
.Cells(lngZeile, intSpalte) = strDateiname
intSpalte = intSpalte + 1
For Each wksTab In Workbooks(strDateiname).Worksheets
.Cells(lngZeile, intSpalte) = wksTab.Name
intSpalte = intSpalte + 1
Next wksTab
Workbooks(strDateiname).Close False
strDateiname = Dir
lngZeile = lngZeile + 1
Loop
End With
Application.ScreenUpdating = True
MsgBox "Anzahl Dateien gefunden: " & anzFiles
End Sub

Gruss Torsten

Beliebteste Forumthreads (12 Monate)

22 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

22
Beiträge zum Forumthread

Beiträge zu diesem Forumthread