VBA - Boucle for each qui s'arrête dès la première valeur trouvée

[rounil09]

Bonsoir le forum,

Malgré mes essais je n'arrive pas à me sortir d'une macro.

Elle fonctionne correctement, mais s'arrête dès que la première valeur égale à la cellule "A3" a été trouvée et copiée (avec les cellules adjacentes).
Malgré le "Next" , la boucle ne continue pas.

Comment faut-il modifier cette macro pour rendre la boucle opérationnelle ?

Sub INTERROCE2()

Dim Cell As Range
Dim TopCell As Range
Dim BottomCell As Range

Sheets("Liste_EP").Select

For Each Cell In Range("I2:I100000")
If Cell.Value = Range("A3").Value Then
Cell.Activate

'Sélectionner les cellules pleines de la ligne, les copier
If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else Set TopCell = ActiveCell.End(xlToLeft)
If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell Else Set BottomCell = ActiveCell.End(xlToRight)
Range(TopCell, BottomCell).Select

Selection.Copy
Sheets("BD_CE").Select
'Se caler dernière cellule vide de la colonne A,coller la sélection
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Goto reference:=Range("A1"), Scroll:=True

End If

Next

End Sub

 

[Banzai64]

Re : VBA - Boucle for each qui s'arrête dès la première valeur trouvée

Bonsoir
Tu commences dans la feuille "Liste_EP"
ensuite tu bascules sur la feuille "BD_CE"
La boucle, elle continue mais pas sur la bonne feuille

Faut bien preciser sur quelle feuille tu fais la boucle For Each .....

For Each Cell In Sheets("Liste_EP").Range("I2:I100000")

Bonne soirée

 

[rounil09]

Re : VBA - Boucle for each qui s'arrête dès la première valeur trouvée

Merci Banzai64 de ta réponse.
Je viens de modifier la macro par copier/coller de ta ligne.
Mais, cela ne modifie rien, la boucle plante toujours au même niveau.

 

[Banzai64]

Re : VBA - Boucle for each qui s'arrête dès la première valeur trouvée

Bonsoir
J'étais en train de simplifier ta macro afin de la comprendre
Pas sur que j'y sois arrivé
Mais cela fonctionne chez moi (avec 2003)

Sub INTERROCE2()

Dim Cell As Range
Dim TopCell As Range
Dim BottomCell As Range

  With Sheets("Liste_EP")
    For Each Cell In .Range("I2:I10")                 '.Range("I2:I100000")
      If Cell.Value = .Range("A3").Value Then
        Cell.Activate
    
        'Sélectionner les cellules pleines de la ligne, les copier
        If IsEmpty(ActiveCell.Offset(-1, 0)) Then
          Set TopCell = ActiveCell
        Else
          Set TopCell = ActiveCell.End(xlToLeft)
        End If
        If IsEmpty(ActiveCell.Offset(1, 0)) Then
          Set BottomCell = ActiveCell
        Else
          Set BottomCell = ActiveCell.End(xlToRight)
        End If
        
        .Range(TopCell, BottomCell).Copy
        
        With Sheets("BD_CE").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
          'Se caler dernière cellule vide de la colonne A,coller la sélection
          .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                              SkipBlanks:=False, Transpose:=False
          .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                              :=False, Transpose:=False
  '      Application.Goto reference:=Range("A1"), Scroll:=True
        End With
      End If
    Next Cell
    
  End With
  Application.CutCopyMode = False
End Sub

A toi de voir

 

[rounil09]

Re : VBA - Boucle for each qui s'arrête dès la première valeur trouvée

Merci de ton aide Banzai64.
Chez moi la macro plante sur cell.activate (avec EXCEL 2007)

Je vais tenter de comprendre pourquoi. Je pense que je devrais me débrouiller.

 

[ROGER2327]

Re : VBA - Boucle for each qui s'arrête dès la première valeur trouvée

Bonsoir à tous

Je pense qu'il faut d'abord activer la feuille "Liste_EP" avant d'activer une cellule de cette feuille :

'...
  With Sheets("Liste_EP")
    .Activate
    For Each Cell In .Range("I2:I10")
     If Cell.Value = .Range("A3").Value Then
        Cell.Activate
'...

​

ROGER2327
#4962

Mercredi 25 Gueules 138 (Sainte Marmelade, Inspirée, SQ)
1er Ventôse An CCXIX
2011-W07-6T23:08:35Z