Re : probleme avec fonction .find
ok, je vais essayé sans etre brouillon
Ma feuille f1 contient 4 colonne (acad - dossard - epreuve - points)
il peut y avoir jusqu'à 26 acad.
il y a autant de dossards que de participants par acad.
Il y a quatre type d'epreuve.
je veux récupérer les données de chaque acad pour les mettre dans un onglet par acad créé à cet effet
les onglet sont créé dans une première étape (le problème ne vient pas de là)
c'est dans la récupération des données.
plus précisément le problème survient quand l'académie en question n'a pas de sossard dans une des épreuves.
le code est un peu long, je vous le met.
Sub copie_vers_acad()
Sheets("F1").Select
Range("f2").Select 'colonne des nb acad
finligne = Range("a1").End(xlDown).Row
ligne3 = Range("f1").End(xlDown).Row
For x = 2 To ligne3
Sheets("F1").Select
name_onglet = Cells(x, 8).Value
acad = Cells(x, 7).Value
Sheets(name_onglet).Range("c1") = name_onglet: Sheets(name_onglet).Range("c2") = acad
'*********************************************************************'
'Recherche de la premiere et derniere ligne de l'acad
With Worksheets("F1").Range(Cells(1, 1), Cells(finligne, 1))
Set c = .Find(acad, LookIn:=xlValues, MatchCase:=True)
firstAddress = c.Address
ligne1 = c.Row
Do
ligne2 = c.Row
Set c = .FindNext(c)
Loop While c.Address <> firstAddress
' Sheets(name_onglet).Range("d6") = ligne1: Sheets(name_onglet).Range("e6") = ligne2
End With
'*********************************************************************'
'*********************************************************************'
'Recherche de la premiere et derniere ligne de l'epreuve course pour l'acad
With Worksheets("F1").Range(Cells(ligne1 - 1, 3), Cells(ligne2, 3))
Set c = .Find("Course", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
ligne1_course = c.Row
Do
ligne2_course = c.Row
Set c = .FindNext(c)
Loop While c.Address <> firstAddress
Range(Cells(ligne1_course, 2), Cells(ligne2_course, 2)).Copy Sheets(name_onglet).Range("b6")
Range(Cells(ligne1_course, 4), Cells(ligne2_course, 4)).Copy Sheets(name_onglet).Range("c6")
End If
End With
'*********************************************************************'
'*********************************************************************'
'Recherche de la premiere et derniere ligne de l'epreuve Lancers pour l'acad
With Worksheets("F1").Range(Cells(ligne1, 3), Cells(ligne2, 3))
Set c = .Find("Lancers", LookIn:=xlValues, MatchCase:=True)
If Not c Is Nothing Then
firstAddress = c.Address
ligne1_lancer = c.Row
Do
ligne2_lancer = c.Row
Set c = .FindNext(c)
Loop While c.Address <> firstAddress
Range(Cells(ligne1_lancer, 2), Cells(ligne2_lancer, 2)).Copy Sheets(name_onglet).Range("d6")
Range(Cells(ligne1_lancer, 4), Cells(ligne2_lancer, 4)).Copy Sheets(name_onglet).Range("e6")
End If
End With
'*********************************************************************'
'*********************************************************************'
'Recherche de la premiere et derniere ligne de l'epreuve Sauts pour l'acad
'
' With Worksheets("F1").Range(Cells(ligne1, 3), Cells(ligne2, 3))
' Set c = .Find("Sauts", LookIn:=xlValues)
' If Not c Is Nothing Then
'
' firstAddress = c.Address
' ligne1_saut = c.Row
' Do
' ligne2_saut = c.Row
' Set c = .FindNext(c)
' Loop While c.Address <> firstAddress
' Range(Cells(ligne1_saut, 2), Cells(ligne2_saut, 2)).Copy Sheets(name_onglet).Range("f6")
' Range(Cells(ligne1_saut, 4), Cells(ligne2_saut, 4)).Copy Sheets(name_onglet).Range("g6")
' End If
' End With
'*********************************************************************'
'*********************************************************************'
'Recherche de la premiere et derniere ligne de l'epreuve relais pour l'acad
' With Worksheets("F1").Range(Cells(ligne1, 3), Cells(ligne2, 3))
' Set c = .Find("Relais", LookIn:=xlValues)
' If Not c Is Nothing Then
' firstAddress = c.Address
' ligne1_relais = c.Row
' Do
' ligne2_relais = c.Row
' Set c = .FindNext(c)
' Loop While c.Address <> firstAddress
'
' Range(Cells(ligne1_relais, 2), Cells(ligne2_relais, 2)).Copy Sheets(name_onglet).Range("h6")
' Range(Cells(ligne1_relais, 4), Cells(ligne2_relais, 4)).Copy Sheets(name_onglet).Range("i6")
' End If
' End With
'*********************************************************************'
Sheets(name_onglet).Select
Call selection_zone_calcul
Call calcul_somme_points
Next
End Sub
