57.scheider
XLDnaute Junior
Hello!
Dans ce code je fais une recherche de reference et si il ne trouve pas je cherche le suivant avec le code "on error" par contre à la 2 eme recherche j'ai un message d'erreur... faut il que je rajoute un "Resume Next" ?
Merci
Dans ce code je fais une recherche de reference et si il ne trouve pas je cherche le suivant avec le code "on error" par contre à la 2 eme recherche j'ai un message d'erreur... faut il que je rajoute un "Resume Next" ?
Merci
Code:
Sub RemplirRefSiprtec()
'pour excuter sur chaque feuille
' For i = 1 To Sheets.Count
' Sheets(i).Name = Sheets(i).Activate
' Next i
If Range("A1").Value = "Nom Armoire" Then
LastFeuil = ActiveSheet.Name
End If
Appareilsuiv:
Err.Clear
For i = 1 To 9
Select Case i
Case 1
devicename = "6MD61"
Case 2
devicename = "6MD66"
Case 3
devicename = "7SA522"
Case 4
devicename = "7SD522"
Case 5
devicename = "7SJ61"
Case 6
devicename = "7SJ640"
Case 7
devicename = "7SJ64"
Case 8
devicename = "7UM62"
Case 9
devicename = "7UT613"
End Select
' If i = 1 Then devicename = "6MD61"
' If i = 2 Then devicename = "6MD66"
' If i = 3 Then devicename = "7SA522"
' If i = 4 Then devicename = "7SD522"
' If i = 5 Then devicename = "7SJ61"
' If i = 6 Then devicename = "7SJ640"
' If i = 7 Then devicename = "7SJ64"
' If i = 8 Then devicename = "7UM62"
' If i = 9 Then devicename = "7UT613"
' End If
'erreur IF
Verifmemeapp:
Columns("B:B").Select
'Si le fichier n'est pas trouvé on passe au prochain
If NombreFois = 4 Then GoTo IncrPrAppareilSuiv
On Error GoTo IncrPrAppareilSuiv
Selection.Find(What:=devicename, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
If NombreFois > 0 Then
For j = 1 To NombreFois
Selection.FindNext(After:=ActiveCell).Activate
Next j
End If
Dim Adresse As Range
Set Adresse = ActiveCell
Sheets("Identification_Globale").Activate
Columns("A:A").Select
Selection.Find(What:=devicename, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Dim Adresseglob As Range
Set Adresseglob = ActiveCell
Sheets(LastFeuil).Activate
Adresse.Offset(2, 0).Value = Adresseglob.Offset(0, 2).Value
Adresse.Offset(6, 0).Value = Adresseglob.Offset(1, 2).Value
Adresse.Offset(7, 0).Value = Adresseglob.Offset(2, 2).Value
Adresse.Offset(8, 0).Value = Adresseglob.Offset(3, 2).Value
NombreFois = NombreFois + 1
GoTo Verifmemeapp
IncrPrAppareilSuiv:
Err.Clear
NombreFois = 0
Next i
GoTo Appareilsuiv
End Sub