Bonjkour,
Ci-joint le code vba, il fonctionne très bien. Mais je voudrais ajouter un onglet "Sta" mais qu'il ne soit pas pris en compte par ce code.
Sub Reponses()
Dim F1 As Worksheet, F2 As Worksheet, F3 As Worksheet, ligne As Long, lig As Byte, col As Byte
Set F1 = Sheets("recap")
Set F2 = Sheets("grille des réponses")
Application.ScreenUpdating = False 'fige l'écran
F1.Range("A2:AR" & F1.Range("C65536").End(xlUp).Row - 1).ClearContents
ligne = 2
For Each F3 In Worksheets 'analyse de chaque feuille
If F3.Name <> F1.Name And F3.Name <> F2.Name Then
F3.[H6:H45] = "OUI"
F1.Cells(ligne, 1) = F3.[I3] 'Date
F1.Cells(ligne, 2) = F3.[B3] 'Site de collecte
F1.Cells(ligne, 3) = F3.[E3] 'Nom
F1.Cells(ligne, 4) = F3.[I4] 'Matricule
F1.Cells(ligne, 5).Resize(, 40) = "OUI"
For lig = 6 To 45
For col = 3 To 7
If (F2.Cells(lig, col).Interior.ColorIndex > 0) <> (F3.Cells(lig, col) <> "") Then
F3.Cells(lig, 8) = "NON"
F1.Cells(ligne, lig - 1) = "NON"
Exit For
End If
Next col
Next lig
ligne = ligne + 1
End If
Next F3
End Sub
Merci pour votre aide
Picronte
Ci-joint le code vba, il fonctionne très bien. Mais je voudrais ajouter un onglet "Sta" mais qu'il ne soit pas pris en compte par ce code.
Sub Reponses()
Dim F1 As Worksheet, F2 As Worksheet, F3 As Worksheet, ligne As Long, lig As Byte, col As Byte
Set F1 = Sheets("recap")
Set F2 = Sheets("grille des réponses")
Application.ScreenUpdating = False 'fige l'écran
F1.Range("A2:AR" & F1.Range("C65536").End(xlUp).Row - 1).ClearContents
ligne = 2
For Each F3 In Worksheets 'analyse de chaque feuille
If F3.Name <> F1.Name And F3.Name <> F2.Name Then
F3.[H6:H45] = "OUI"
F1.Cells(ligne, 1) = F3.[I3] 'Date
F1.Cells(ligne, 2) = F3.[B3] 'Site de collecte
F1.Cells(ligne, 3) = F3.[E3] 'Nom
F1.Cells(ligne, 4) = F3.[I4] 'Matricule
F1.Cells(ligne, 5).Resize(, 40) = "OUI"
For lig = 6 To 45
For col = 3 To 7
If (F2.Cells(lig, col).Interior.ColorIndex > 0) <> (F3.Cells(lig, col) <> "") Then
F3.Cells(lig, 8) = "NON"
F1.Cells(ligne, lig - 1) = "NON"
Exit For
End If
Next col
Next lig
ligne = ligne + 1
End If
Next F3
End Sub
Merci pour votre aide
Picronte