Je n'arrive pas à faire la boucle de recherche pour extraire les lignes selon une don

[Boby71C]

Re bonjours à tous.

Je me suis lancé dans un sujet colossal et je bloque.
Je désir extraire des ligne selon des données en colonnes AG et AH selon le critère renseigné en AG1.

Pour savoir jusqu'ou tester, nous testerons sur la colonne B qui est toujours renseignée.

Je renseigne un chiffre en AG1, entre 1 et 12 qui représente les mois.
Si la ligne testée contient en colonne AG le même chiffre qu'en AG1, nous collons cette ligne dans la feuille Calcul_T à la suite des données existantes.

Si la ligne testée contient en colonne AH le même chiffre qu'en AG1, nous collons cette ligne dans la feuille Calcul_D à la suite des données existantes.

Je joints un extrait de fichier
Mon original fait 4MO

Merci pour votre aide
@+

 

[Compte Supprimé 979]

Re : Je n'arrive pas à faire la boucle de recherche pour extraire les lignes selon une don

Salut Boby71C,

Utilises ce code avec un bouton

Sub CopieLigne()
  Dim Cel As Range, DerLig As Integer, Lig As Integer, VSearch As Integer
  Dim LigDest As Integer
  VSearch = ActiveSheet.Range("AG1").Value
  DerLig = ActiveSheet.Range("B65536").End(xlUp).Row
  For Each Cel In Range("B3:B" & DerLig)
    Lig = Cel.Row
    If Range("AG" & Lig).Value = VSearch Then
      LigDest = Sheets("Calcul_T").Range("B65536").End(xlUp).Offset(1, 0).Row
      Rows(Lig).Copy Destination:=Sheets("Calcul_T").Rows(LigDest)
    End If
    If Range("AH" & Lig).Value = VSearch Then
      LigDest = Sheets("Calcul_D").Range("B65536").End(xlUp).Offset(1, 0).Row
      Rows(Lig).Copy Destination:=Sheets("Calcul_D").Rows(LigDest)
    End If
  Next
  MsgBox "C'est FAIT !"
End Sub

Voilà 😉

 

[Excel_lent]

Re : Je n'arrive pas à faire la boucle de recherche pour extraire les lignes selon un

Bonsoir,

autre solution mais en faisant attention aux formats des cellules testées !

Dim l1 As Long, l2 As Long, l3 As Long
Sub test()
l2 = Range("Calcul_T!B65536").End(xlUp).Row + 1
l3 = Range("Calcul_D!AB5536").End(xlUp).Row + 1
Sheets("Encours").Select
For l1 = 3 To Range("B65535").End(xlUp).Row
  If Val(Range("AG" & l1)) = Range("AG1") Then
    Range("B" & l1 & ":AJ" & l1).Copy Destination:=Range("Calcul_T!B" & l2)
    l2 = l2 + 1
  End If
  If Val(Range("AH" & l1)) = Range("AG1") Then
    Range("B" & l1 & ":AJ" & l1).Copy Destination:=Range("Calcul_D!B" & l3)
    l3 = l3 + 1
  End If
Next l1
End Sub

@+

 

[Compte Supprimé 979]

Re : Je n'arrive pas à faire la boucle de recherche pour extraire les lignes selon une don

Salut Excel Lent,

autre solution mais en faisant attention aux formats des cellules testées !

Oui effectivement, il faut y penser !

Mais pour moi un numérique est un numérique et pas un texte, mais bon on ne sait jamais ...

 

[dixit]

Re : Je n'arrive pas à faire la boucle de recherche pour extraire les lignes selon une don

bonsoir à tous,
voici une autre proposition (macro nommée test) sur base du fichier joint d'origine.

 

[Boby71C]

Re : Je n'arrive pas à faire la boucle de recherche pour extraire les lignes selon une don

Merci les amis
Je vais tester demain si le mauvais temps continue.
Je vous souhaite un excellent Week End et un très grand merci.

@+