Sub extraction()
Dim Ligne As Long ' n° ligne classeur 1
Dim Ligne2 As Long ' n° ligne classeur 2
Dim Ligne3 As Long ' n° ligne classeur 3
Dim Trouve As Boolean
' Créer un nouveau Classeur
Workbooks.Add
Classeur3 = ActiveWorkbook.Name
Ligne3 = 2
Ligne = 3
'lire chaque ligne du classeur 1
While Workbooks("Classeur1.xlsx").Sheets("Projet & Production").Cells(Ligne, 2) <> ""
If Workbooks("Classeur1.xlsx").Sheets("Projet & Production").Cells(Ligne, 6) = "DEMANDE DE CHANGEMENT GCE" _
Or Workbooks("Classeur1.xlsx").Sheets("Projet & Production").Cells(Ligne, 6) = "DEMANDE DE CHANGEMENT EDITEUR" _
Then
' le test peu être If Workbooks("Classeur1.xlsx").Sheets("Projet & Production").Cells(Ligne, 6) like "DEMANDE DE CHANGEMENT*" then
'Compare à chaque ligne du classeur 2
Ligne2 = 2
Trouvé = False
Do
If Workbooks("Classeur1.xlsx").Sheets("Projet & Production").Cells(Ligne, 2) = _
Workbooks("Classeur2.xlsm").Sheets("Anomalies en cours").Cells(Ligne2, 3) Then
Trouve = True ' égalité classeur 1 et 2 on sort de la boucle
Exit Do
End If
Ligne2 = Ligne2 + 1
Loop While Workbooks("Classeur2.xlsm").Sheets("Anomalies en cours").Cells(Ligne2, 2) <> ""
'recopie vers classeur 3 si pas trouvé dans classeur 2
If Trouve = False Then
With Workbooks(Classeur3).Sheets(1)
.Cells(Ligne3, 1) = Workbooks("Classeur1.xlsx").Sheets("Projet & Production").Cells(Ligne, 2)
.Cells(Ligne3, 2) = Workbooks("Classeur1.xlsx").Sheets("Projet & Production").Cells(Ligne, 6)
.Cells(Ligne3, 3) = Workbooks("Classeur1.xlsx").Sheets("Projet & Production").Cells(Ligne, 9)
.Cells(Ligne3, 4) = Workbooks("Classeur1.xlsx").Sheets("Projet & Production").Cells(Ligne, 10)
' recopie de chaque colonne
Ligne3 = Ligne3 + 1
End With
End If
End If
Ligne = Ligne + 1
Wend
End Sub