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