Macro recherche avec une boucle.

[CHEPAS65]

Bonsoir à tous

Voila j'ai une macro qui me permet de chercher dans une feuille l'élément (I -), puis de copier certaines informations existants sur la même ligne vers une feuille de résultats. Le probleme que j'ai, est que je n'arrive pas implémenter cette macro dans une boucle afin de chercher toute la feuille.

Voici ma macro et mon tableau:

Sub RECHE2()
'
Windows("TEST1").Activate
Range("A1").Select
Cells.Find(What:="I -", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range("A2,B2,H2,P2").Select
Range("P13").Activate
Selection.Copy
Sheets("Resultat").Select
Range("A1").Select
ActiveSheet.Paste'

si quelqu un a une idée cela serait super sympa 😱

merci d'avance

 

[Fred0o]

Re : Macro recherche avec une boucle.

Bonsoir CHEPAS65 et bienvenue sur le forum.

Voici ton code modifié.

Sub RECHE2()
'
    Application.ScreenUpdating = False
    Windows("TEST1.xls").Activate
    Dim i, j, sh
    j = 2
    sh = ActiveSheet.Name
    For i = 2 To Range("A65536").End(xlUp).Row
        If Left(Range("A" & i), 3) = "I -" Then
            Union(Range("A" & i), Range("B" & i), Range("H" & i), Range("P" & i)).Select
            Selection.Copy
            Sheets("Résultat").Select
            Range("A" & j).Select
            ActiveSheet.Paste
            j = j + 1
            Sheets(sh).Select
        End If
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

A+

 

[CHEPAS65]

Re : Macro recherche avec une boucle.

Merci beaucoup Fred0o, c est exactement ce dont j avais besoin.

 

[TempusFugit]

Re : Macro recherche avec une boucle.

Bonjour


Une autre méthode en passant par le filtre automatique

Sub TESTavecFILTRE()
Dim ChambreI As Range
With Sheets("Sheet1")
    .Range("A1:Q65").AutoFilter Field:=1, Criteria1:="=I -*"
    Set ChambreI = Range("_FilterDataBase")
    Intersect(ChambreI.Offset(1).Resize(ChambreI.Rows.Count - 1), _
    .Range("A:A,B:B,H:H,P:P")).Copy Sheets("Résultat").Cells(Rows.Count, "A").End(xlUp).Offset(1)
    .AutoFilterMode = False
End With
Application.CutCopyMode = False
Sheets("Résultat").Activate
End Sub

 

[CHEPAS65]

Re : Macro recherche avec une boucle.

Très bon aussi, merci

 

[CHEPAS65]

Re : Macro recherche avec une boucle.

Re Bonjour,

J'ai réutiliser ton code dans un autre tableau, il fonctionne bien. Mais comme je voudrais qu'il me compile les résultats de 20 classeurs, il deviens vite très long. N'y aurait-il pas la possibilité de le simplifier? (en mettant par exemple juste le nombre de classeurs à utiliser?).

Merci d'avance.


Sub TEST1()

Application.ScreenUpdating = False
Windows("CAISSE2.xls").Activate Dim i, j, sh
j = 10
sh = ActiveSheet.Name
For i = 2 To Range("A65536").End(xlUp).Row
If Left(Range("F" & i), 4) = "Visa" Then
Range("L" & i).Select
Selection.Copy
Sheets("Résultat").Select
Range("A" & j).Select
ActiveSheet.Paste
j = j
Sheets(sh).Select
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
sh = ActiveSheet.Name
For i = 1 To Range("A65536").End(xlUp).Row
If Left(Range("F" & i), 8) = "Virement" Then
Range("L" & i).Select
Selection.Copy
Sheets("Résultat").Select
Range("B" & j).Select
ActiveSheet.Paste
j = j
Sheets(sh).Select
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True

Windows("CAISSE3.xls").Activate
j = 11
sh = ActiveSheet.Name
For i = 2 To Range("A65536").End(xlUp).Row
If Left(Range("F" & i), 4) = "Visa" Then
Range("L" & i).Select
Selection.Copy
Windows("CAISSE2.xls").Activate
Sheets("Résultat").Select
Range("A" & j).Select
ActiveSheet.Paste
j = j
Sheets(sh).Select
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
sh = ActiveSheet.Name
For i = 1 To Range("A65536").End(xlUp).Row
If Left(Range("F" & i), 8) = "Virement" Then
Range("L" & i).Select
Selection.Copy
Windows("CAISSE2.xls").Activate
Sheets("Résultat").Select
Range("B" & j).Select
ActiveSheet.Paste
j = j
Sheets(sh).Select
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[Fred0o]

Re : Macro recherche avec une boucle.

Bonjour CHEPAS65,

Voici le code que tu peux utiliser, en adaptant les bornes de la variable cl à ton cas :

Sub RECHE2()
'
    Application.ScreenUpdating = False
    Dim i, j, sh, cl
    For cl = 1 To 20
        Windows("CAISSE" & cl & ".xls").Activate
        j = 10
        sh = ActiveSheet.Name
        For i = 2 To Range("A65536").End(xlUp).Row
            If Left(Range("F" & i), 4) = "Visa" Then
                Range("L" & i).Select
                Selection.Copy
                Sheets("Résultat").Select
                Range("A" & j).Select
                ActiveSheet.Paste
                j = j
                Sheets(sh).Select
            End If
        Next
        For i = 1 To Range("A65536").End(xlUp).Row
            If Left(Range("F" & i), 8) = "Virement" Then
                Range("L" & i).Select
                Selection.Copy
                Sheets("Résultat").Select
                Range("B" & j).Select
                ActiveSheet.Paste
                j = j
                Sheets(sh).Select
            End If
        Next
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

A+

 

[CHEPAS65]

Re : Macro recherche avec une boucle.

Bonsoir Fredoo,

Merci beaucoup pour le nouveau code, il marche bien. Le seul problème est que toutes les données sont copiées sur la même ligne et du coup, je ne retrouve que les chiffres du dernier classeur. Est-il possible de modifier le code afin d'avoir les classeurs copiés les uns après les autres? (J'ai essayé avec j = j + 1 Sheets(sh).Select mais ça ne marche pas)

Merci d'avance.

 

[Fred0o]

Re : Macro recherche avec une boucle.

Bonsoir CHEPAS65,

Tes fichiers sont bizarrement fichus, le mode de paiement n'est pas toujours aligné dans la colonne F. En attendant plus d'éclaircissement, regardes un premier jet dans le fichier ci-joint.

A+

 

[CHEPAS65]

Re : Macro recherche avec une boucle.

Bonjour Fredoo,

Merci pour ta réactivité et le fichier que tu m'a envoyé. Il marche bien, la seule question que j aurais est comment faire pour que dans le cas ou la macro recherche ne trouve rien qu'elle laisse la cellule correspondante vide et passe directement à la ligne suivante.

Merci.

PS. J'ai bien vérifié sur les classeurs, la colonne F contient toujours les moyens de paiements (visa....)