copie de ligne automatique

[taupivin]

Bonjour à tous,

J'aurai aimer votre avis pour savoir comment rendre automatique la copie de toutes les lignes comprenant un "x" (colonne A) dans la feuille "Activités finies".
Aujourd'hui je n'arrive à faire mes couper/coller que par de multiples clics sur le bouton correspondant.

Je pense à insérer un for each next mais je ne vois pas comment l'insérer dans mon code.

Merci d'avance pour votre aide,

Bien cordialement,

 

[Guest]

Re : copie de ligne automatique

Bonjour,

Pas besoin de mettre une boucle pour peu que ta macro s'interesse aux bonnes lignes!

Ta plage commence en A10 et non en A1!

Private Sub Actualiser_Click()
Dim LastLig As Long
Dim cDest As Range
Application.ScreenUpdating = False
With ThisWorkbook
    'cDest: La celllule de destination: première cellule vide de la colonne A de Activités finies
    With .Worksheets("Activitées finies")
        Set cDest = .Cells(.Rows.Count, "A").End(xlUp)(2)
    End With
    With .Worksheets("Vincent") ' A CHANGER SELON LE NOM DE L UTILISATEUR
   
        'Enlève l'éventuel filtre automatique
        .AutoFilterMode = False
        
        'LastLig, ligne de la dernière cellule remplie de colonne A de Vincent
        LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    
        'On fait un filtre automatique sur la colonne A de Vincent avec comme critère "x"
        .Range("A10:A" & LastLig).AutoFilter field:=1, Criteria1:="x"
   
        
        'Si au moins une ligne résultat du filtre (en plus de la ligne 1 des titres)
        If .Range("A10:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
            With .Range("A10:A" & LastLig).SpecialCells(xlCellTypeVisible).Resize(, 9)
                'On copie toutes les lignes visibles vers cDest (sauf la ligne des titres)
                .Cut cDest
          End With
        End If
        
        'on vide notre variable cDest
        Set cDest = Nothing
        
        'On enlève le filtre automatique
        .AutoFilterMode = False
        
    End With
End With
End Sub

A+

 

[Robert]

Re : copie de ligne automatique

Bonjour Taupivin, bonjour le forum,

Peut-être comme ça :

Private Sub Actualiser_Click()
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim Dest As Range 'déclare la variable dest (cellule de DESTination)
Dim pl As Range 'déclare la variable pl (PLage)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set Dest = Sheets("Activitées finies").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
With Worksheets("Vincent") 'prend en compte l'onglet "Vincent" (A CHANGER SELON LE NOM DE L UTILISATEUR)
    .AutoFilterMode = False 'Enlève l'éventuel filtre automatique
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 1 (=A)
    Set pl = .Range("A10:I" & dl) 'définit la plage pl
    .Range("A9").AutoFilter field:=1, Criteria1:="x" 'filtre automatique sur la colonne A avec comme critère "x"
    'Si au moins une ligne résultat du filtre, copie les lignes filtrées et les colle dans dest
    If pl.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then pl.SpecialCells(xlCellTypeVisible).Cut Dest
    .AutoFilterMode = False    'supprime le filtre automatique
End With 'fin de la prise en compte de l'onglet "Vincent"
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

[Édition]
Bonjour Hasco on s'est croisé...

 

[taupivin]

Re : copie de ligne automatique

Merci beaucoup pour votre aide. A+