Sub Macro1()
Dim Lg_Active_1 As Integer
Dim Lg_Active_2 As Integer
Dim Nb_ligne As Integer
Dim X As Integer
'Calcul du nombre de ligne à vérifier
Nb_ligne = Sheets('feuil1').Range('A1').End(xlDown).Row
'Si le nombre de lignes est incohérent, on sort
If Nb_ligne 65000 Then
'avertissement
MsgBox ('nb lignes = ' & Nb_ligne & Chr(13) & _
'valeur incohérent : arrêt macro')
Exit Sub
End If
'Calcul de la ligne active feuille 2
Lg_Active_2 = Sheets('feuil2').Range('A1').End(xlDown).Row + 1
'Boucle de transfert
For Lg_Active_1 = 1 To Nb_ligne
If UCase(Sheets('feuil1').Cells(Lg_Active_1, 3)) ****différent de**** 'K7' And _
UCase(Sheets('feuil1').Cells(Lg_Active_1, 3)) ****différent de**** 'G7' Then
'pas K7 ou G7
'on copie
Sheets('feuil1').Activate
ActiveSheet.Range('A' & Lg_Active_1 & ':D' & Lg_Active_1).Copy
Sheets('Feuil2').Activate
'on colle
Range('A' & Lg_Active_2).Select
ActiveSheet.Paste
'marquage ligne à effacer
Sheets('Feuil1').Cells(Lg_Active_1, 8) = 'X'
'ligne suivante (vide)
Lg_Active_2 = Lg_Active_2 + 1
End If
Next
'Effacement des lignes marquées
Sheets('feuil1').Activate
For X = Nb_ligne To 1 Step -1
If Cells(X, 8) = 'X' Then
Range('A' & X & ':H' & X).Select
Selection.Delete Shift:=xlUp
End If
Next
End Sub