Boucle qui ne boucle pas...

yannick64 · 9 Février 2018

Bonjour à tous,

J'essaye en vain de faire fonctionner ce code VBA, il doit y avoir une erreur mais je ne vois pas ou... Ce code ne fonctionne qu'une fois alors que je lui demande de boucler jusqu’à la ligne 200 ou jusqu’à la première cellule vide de la colonne K. Si quelqu'un peu jeter un coup d’œil...

Merci par avance
Yannick

VB:

Sub Rectangle1_Cliquer()
'
'
'Sélection de la feuille Listing complet
Sheets("Listing complet").Select
Range("K5:K200").Select
'
'Vérification du critère de sélection indice Zone 1, 2 ou 3
Do While ActiveCell.Value <> "" 'Boucle tant qu'on ne tombe pas sur une cellule vide
        If ActiveCell.Value Like "1" Then

            ligne = ActiveCell.Row              'on stocke le numéro de ligne
            controle = Cells(ligne, 3).Value    'on stocke le numéro fi pour vérification des doublons

            'copie de la ligne (colonne A à Y)
            Range(Cells(ligne, 1), Cells(ligne, 14)).Copy
            Sheets("FS Alerte Z1").Activate
            Range("A3").Select
           
         
                    'Collage de la ligne
                    ActiveSheet.Paste
                    Sheets("FS Alerte Z1").Select
                    ActiveCell.Offset(1, 0).Select

        'pas de 1 dans la cellule
        Else
            ActiveCell.Offset(1, 0).Select
    End If

Loop

End Sub

Staple1600 · 20 Mars 2018

Bonsoir le fil, le forum

@yannick64
De mémoire, il y a rien dans mon code qui masque ou masquait des lignes, non ?

Lone-wolf · 20 Mars 2018

Bonsoir tout le monde

Yannick à dit: Boucle qui ne boucle pas...

Bein oui... c'est comme certains, on a du mal à les boucler.

Ave à toi Calvus tetum sans cheveulux

yannick64 · 21 Mars 2018

Bonjour à tous,

Je me suis peut être mal exprimé...
Si je comprends bien le code et vu ce que j'obtiens en l’exécutant, l'AutoFilter "masque" certaines lignes et je ne peux pas les ré-afficher même en sélectionnant les lignes avant et après et en faisant clic droit --> afficher. J'ai aussi essayé d'annuler l'AutoFilter ou de faire un ShowAllData mais ça n'a pas fonctionné non plus

Du coup je ne peux plus utiliser le fichier pour les autres manipulations.
Merci d'avance
Yannick

gosselien · 21 Mars 2018

Bonjour,

145 lignes avant de filtrer et 145 après...
et des données dans les 3 onglets visés

Donc le code TransfertFSAlerte fait le taf

P.

yannick64 · 21 Mars 2018

Il doit y voir un problème chez moi alors, car moi j'obtiens ce qui est sur l'image jointe sans possibilité de faire réapparaitre les lignes manquantes...

Yannick

Staple1600 · 21 Mars 2018

Bonsoir le fil, le forum

@yannick64
Peux-tu poster dans le corps du message la version actuelle de ma macro que tu utilises, stp ?

yannick64 · 21 Mars 2018

C'est celui là.

Merci pour ton aide !
Yannick

VB:

Sub TransfertFSAlerte()
Dim i
On Error Resume Next
Feuil4.Cells.Clear: Feuil5.Cells.Clear: Feuil6.Cells.Clear
Application.ScreenUpdating = False
For i = 1 To 3
With Worksheets("Listing complet").ListObjects("tableau1")
    .Range.AutoFilter Field:=11, Criteria1:=i
    .DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
End With
Sheets("FS Alerte Z" & i).Range("A1").PasteSpecial xlValues
Next
With Worksheets("Listing complet")
.ListObjects("Tableau1").Sort.SortFields.Clear: .ShowAllData: .Select
End With
ActiveSheet.ShowAllData
    End Sub

Staple1600 · 21 Mars 2018

Re

Entre ta macro et ma macro, je vois une différence
Sauras-tu trouver laquelle ?

VB:

Sub Macro2()
Dim i
On Error Resume Next
Feuil4.Cells.Clear: Feuil5.Cells.Clear: Feuil6.Cells.Clear
Application.ScreenUpdating = False
For i = 1 To 3
With Worksheets("Listing complet").ListObjects("tableau1")
    .Range.AutoFilter Field:=11, Criteria1:=i
    .DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
End With
Sheets("FS Alerte Z" & i).Range("A1").PasteSpecial xlValues
Next
With Worksheets("Listing complet")
.ListObjects("Tableau1").Sort.SortFields.Clear: .ShowAllData: .Select
End With
End Sub

yannick64 · 21 Mars 2018

Oui c'est moi qui avait ajouté cette ligne pour essayer de forcer l'affichage des lignes disparues mais sans succès... Même sans cette ligne mon problème reste le même...
Je te renvoi le fichier complet avec la macro qui ne fonctionne pas chez moi au cas ou il y ai un loup quelque part

Staple1600 · 21 Mars 2018

Re

Ceci semble résoudre le problème, non ?

VB:

Sub TransfertFSAlerte()
Dim i
On Error Resume Next
Feuil4.Cells.Clear: Feuil5.Cells.Clear: Feuil6.Cells.Clear
Application.ScreenUpdating = False
    For i = 1 To 3
        With Worksheets("Listing complet").ListObjects("Tableau1").DataBodyRange
            .AutoFilter
            .AutoFilter Field:=11, Criteria1:=i
            .SpecialCells(xlCellTypeVisible).Copy
            Sheets("FS Alerte Z" & i).Range("A1").PasteSpecial xlValues
        Application.CutCopyMode = False
            .AutoFilter
        End With
    Next
End Sub

yannick64 · 21 Mars 2018

Super ! cette fois ci j'ai bien toutes mes lignes qui sont visibles.
UN GRAND MERCI A TOI !

Bonne soirée
Yannick

Boucle qui ne boucle pas...

yannick64

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Lone-wolf

XLDnaute Barbatruc

yannick64

XLDnaute Junior

gosselien

XLDnaute Barbatruc

yannick64

XLDnaute Junior

Pièces jointes

Staple1600

XLDnaute Barbatruc

yannick64

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

yannick64

XLDnaute Junior

Pièces jointes

Staple1600

XLDnaute Barbatruc

yannick64

XLDnaute Junior

Discussions similaires