Hallo
Ich habe folgenden guten Makro von Ramses im Archiv gefunden.
Dim Suchpfad As String, findStr As String, Fichier As String ', msgTxt As String
Dim qe As Integer, myMatch As String, sAddress As String
Dim wks As Worksheet, wb As Workbook
Dim myRng As Range, totFiles As Integer, i As Integer, gefFile As Variant
Dim oldStatus As Variant
' Remplir les variables
Fichier = "*.xls"
Suchpfad = InputBox("Dans quel fichier voulez vous cherchez?:", "G:\doc\commun\Bureau chefdépt\depot\octobre", "G:\doc\commun\Bureau chefdépt\Depot\octobre")
If Suchpfad = "" Then Exit Sub
findStr = InputBox("Notez le numero du numero courant ou le numero du bon livraison s.v.p.", "Numero")
If findStr = "" Then Exit Sub
myMatch = xlWhole
Application.ScreenUpdating = False
'text in die Stausbar aufnehmen
oldStatus = Application.StatusBar
'Start der Suchroutine
With Application.FileSearch
.NewSearch
.LookIn = Suchpfad
.Filename = Fichier
If .Execute() &gt 0 Then
totFiles = .FoundFiles.Count
'Ausgabe in der Statusbar
Application.StatusBar = "Total" & totFiles & " trouver"
For i = 1 To .FoundFiles.Count
gefFile = .FoundFiles(i)
Set wb = Application.Workbooks.Open(gefFile)
Application.StatusBar = "Fichier" & i & "de" & totFiles & "Suchpfad"
For Each wks In wb.Worksheets
Set myRng = wks.Cells.Find(What:=findStr, LookAt:=myMatch, LookIn:=xlFormulas)
If Not myRng Is Nothing Then
sAddress = myRng.Address
Do
Application.Goto myRng, True
If MsgBox(" Continuer la Suchpfad?", vbYesNo + vbQuestion) = vbNo Then
GoTo exitsearch
End If
'Set myRng = Cells.FindNext(After:=ActiveCell)
Loop
End If
Next
wb.Close
Set wb = Nothing
Next i
End If
'Exit for:
End With
MsgBox prompt:="Plus rien trouver"
exitsearch:
Application.StatusBar = oldStatus
Application.ScreenUpdating = True
End sub
Nun möchte ich dass er nur in der Range C der jeweiligen Mappe durchsucht.
Was muss ich verändern?