Bonjour
ça fait une semaine que je suis bloqué sur un sujet ; je lance la recherche d'un mot dans l'ensemble des feuilles sur le classeur ( en cliquant sur le bouton go) et ça se reporte sur une feuille "Temp" , mon 1er souci c'est que je désire copier toute ligne ou se situe le mote trouvé , mon 2ème souci est que dès que je lance une nouvelle recherche d'un nouveau mot l'ancienne data retrouvée s'écrase et se remplace par la nouvelle , voici mon programme :
Private Sub B_ok_Click()
If Me.TextBox1 = "" Then Exit Sub
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Temp").Delete
On Error GoTo 0
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Temp"
[A667] = Me.TextBox1
For i = 1 To 2
With Sheets(i).Cells
If IsDate(Me.TextBox1) Then
Set c = .Find(CDate(Me.TextBox1), LookIn:=xlValues, LookAt:=xlPart)
Else
Set c = .Find(Me.TextBox1, LookIn:=xlValues, LookAt:=xlPart)
ligne = Sheets("Temp").Range("a65536").End(xlUp).Row + 1
End If
If Not c Is Nothing Then
premier = c.Address
Do
temp = [A667]
Sheets("Temp").Hyperlinks.Add Anchor:=Sheets("Temp").Cells(xlCellTypeBlanks, 1), _
Address:="", SubAddress:="'" & Sheets(i).Name & "'" & "!" & c.Address, TextToDisplay:=temp 'Sheets(i).Name
Cells(ligne, 2) = Sheets(i).Name
Cells(ligne, 3) = c.Address
ligne = ligne + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> premier
End If
End With
Next i
End Sub
merci pour votre aide
ça fait une semaine que je suis bloqué sur un sujet ; je lance la recherche d'un mot dans l'ensemble des feuilles sur le classeur ( en cliquant sur le bouton go) et ça se reporte sur une feuille "Temp" , mon 1er souci c'est que je désire copier toute ligne ou se situe le mote trouvé , mon 2ème souci est que dès que je lance une nouvelle recherche d'un nouveau mot l'ancienne data retrouvée s'écrase et se remplace par la nouvelle , voici mon programme :
Private Sub B_ok_Click()
If Me.TextBox1 = "" Then Exit Sub
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Temp").Delete
On Error GoTo 0
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Temp"
[A667] = Me.TextBox1
For i = 1 To 2
With Sheets(i).Cells
If IsDate(Me.TextBox1) Then
Set c = .Find(CDate(Me.TextBox1), LookIn:=xlValues, LookAt:=xlPart)
Else
Set c = .Find(Me.TextBox1, LookIn:=xlValues, LookAt:=xlPart)
ligne = Sheets("Temp").Range("a65536").End(xlUp).Row + 1
End If
If Not c Is Nothing Then
premier = c.Address
Do
temp = [A667]
Sheets("Temp").Hyperlinks.Add Anchor:=Sheets("Temp").Cells(xlCellTypeBlanks, 1), _
Address:="", SubAddress:="'" & Sheets(i).Name & "'" & "!" & c.Address, TextToDisplay:=temp 'Sheets(i).Name
Cells(ligne, 2) = Sheets(i).Name
Cells(ligne, 3) = c.Address
ligne = ligne + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> premier
End If
End With
Next i
End Sub
merci pour votre aide