mehrere xls, bestimmtes Blatt nach bestimmten Wert

Sub tt() Application.DisplayAlerts = False Application.ScreenUpdating = False On Error Resume Next wort = InputBox("Suchwort") Set fs = Application.FileSearch With fs .LookIn = "D:\kalk" .Filename = "*.xls" .Execute For i = 1 To .FoundFiles.Count Workbooks.Open .FoundFiles(i) erg = Cells.Find(What:=wort, LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _ .Activate If erg Then MsgBox wort & " gefunden in " & .FoundFiles(i) Workbooks(Mid(.FoundFiles(i), InStrRev(.FoundFiles(i), "\") + 1)).Close SaveChanges: _ =False Next i End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Servus Sebastian,
hier mal als Ansatz:
Option Explicit


Sub tt()
Dim Dateien As Integer
Dim DateiName As String, Dateipfad As String
Dim suche As Range, searchIt As Range
Dim Finde As Range
Dim strErste As String, strFirst As String
Dim zähler As Double
Application.DisplayAlerts = False
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = "D:\kalk"
.SearchSubFolders = True
.Filename = "*" & ".xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
zähler = 0
DateiName = Dir(.FoundFiles(Dateien))
Dateipfad = .FoundFiles(Dateien)
If DateiName  ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
Set Finde = Workbooks(DateiName).Sheets("Summary").Range("A1:IV65536")
Set suche = Finde.Find(what:="EK", LookAt:=xlWhole, SearchOrder:=xlByRows,  _
SearchDirection:=xlNext)
If Not suche Is Nothing Then
strErste = suche.Address
Do
zähler = zähler + 1
Set suche = Finde.FindNext(suche)
Loop While Not suche Is Nothing And suche.Address  strErste
MsgBox "In File: " & DateiName & " ist der Eintrag EK " & zähler & "-mal  _
enthalten"
End If
zähler = 0
Set searchIt = Finde.Find(what:="EP", LookAt:=xlWhole, SearchOrder:=xlByRows,  _
SearchDirection:=xlNext)
If Not searchIt Is Nothing Then
strFirst = searchIt.Address
Do
zähler = zähler + 1
Set searchIt = Finde.FindNext(searchIt)
Loop While Not searchIt Is Nothing And searchIt.Address  strFirst
MsgBox "In File: " & DateiName & " ist der Eintrag EP " & zähler & "-mal  _
enthalten"
End If
End If
ActiveWorkbook.Close
Set suche = Nothing
Set searchIt = Nothing
Set Finde = Nothing
Next
End If
End With
End Sub

Öffnet alle Dateien in diesem Ordner und Unterordnern und zählt jeweils die Einträge EK und EP und gibt diese als MsGBox aus (jeweils pro Datei)
Gruß
Chris

Beliebteste Forumthreads (12 Monate)

mehrere xls, bestimmtes Blatt nach bestimmten Wert

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

mehrere xls, bestimmtes Blatt nach bestimmten Wert

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread