Boucle qui ne boucle pas...

yannick64

yannick64

XLDnaute Junior
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
 
Trier par date Trier par votes
yannick64

yannick64

XLDnaute Junior
Bonjour à tous,

Je me suis peut être mal exprimé... :confused:
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
 
Vote positif 0 Vote négatif
yannick64

yannick64

XLDnaute Junior
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
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
yannick64

yannick64

XLDnaute Junior
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:confused:
 

Pièces jointes

  • Listing habitants anonyme.xlsm
    40.7 KB · Affichages: 20
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
207
Compte Supprimé 979
C
D
  • Question
Autres boucle copier ligne
Réponses
2
Affichages
300
dadaze
D
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
180
Francky79
F
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
77
Latias
L
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
558
Vermithor
V
Z
  • Question
Microsoft 365 Ajouter une étiquette de confidentialité via macro
Réponses
4
Affichages
859
onobyone
O
B
  • Question
XL 2016 Interférence entre une boucle et un copie de feuille
Réponses
4
Affichages
335
Oneida
Oneida
E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
147
eric72
E
F
  • Question
XL 2010 Appeler une macro dans une autre
Réponses
5
Affichages
339
Dranreb
Dranreb
V
  • Résolu(e)
XL 2016 Exportation au format PDF à l'aide d'une macro : erreur 1004 'Document non enregistré'
Réponses
14
Affichages
518
Phil69970
Phil69970

Membres actuellement en ligne

17 membres et 290 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 201
Messages
2 086 168
Membres
103 151
dernier inscrit
nassim