Microsoft 365 Perfectionner une Macro

Wisefun77 · 19 Août 2022

Bonjour,
Cette macro fonctionne bien.

Code:

Sub todocopy()
Worksheets("Suivi").UsedRange.Copy
 Worksheets("TODO").Paste _
 Worksheets("TODO").Range("A1")
 Application.CutCopyMode = False
  Debut = 3
 Fin = 990
 ColNb = 1
For i = Debut To Fin
If Cells(i, ColNb).Value = "TO DO" Then
Cells(i, ColNb).EntireRow.Hidden = False
Else
Cells(i, ColNb).EntireRow.Hidden = True
End If
Next i
Worksheets("TODO").Activate
End Sub

Je me demande si je ne pourrai pas l'améliorer.

En fait il faudrait que je dise :

Si dans la colonne A depuis la ligne 2 à la ligne 1000 , il y a dans une cellule le mot "OK"

Alors copier toutes les lignes dans la feuille "OK" à partir de la ligne 2.

J'ai essayé mais je vois pas comment lui donner le mot à rechercher.

Ce code fait afficher de suite la MsgBox, et tourne en boucle, je dois arrêter le processus Excel via le gestionnaire des tâches.

VB:

Sub okcopy2()
 Debut = 2
 Fin = 990
 ColNb = 1
For i = Debut To Fin
If Cells(i, ColNb).Value = "OK" Then
Worksheets("Suivi").UsedRange.Copy
 Worksheets("OK").Paste _
 Worksheets("OK").Range("A1")
 Application.CutCopyMode = False
Else
MsgBox "Pas d'incident de fermé"
End If
Next i
Worksheets("OK").Activate
End Sub

Merci à vous.

danielco · 22 Août 2022

Bonjour,
Essaie :

VB:

Sub test()
  Dim Plage As Range
  With Sheets("Suivi")
    .ListObjects(1).Range.AutoFilter 1, "ok"
    Set Plage = .ListObjects(1).AutoFilter.Range
    If Application.Subtotal(103, Plage.Resize(, 1)) > 1 Then
      Plage.Offset(1).Resize(Plage.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy [OK!A2]
      .ListObjects(1).Range.AutoFilter
    End If
  End With
End Sub

vgendron · 19 Août 2022

Bonjour

tu souhaites copier ou affficher les lignes ?
avec un fichier exemple, on pourra t'aider.

Deadpool_CC · 19 Août 2022

Wisefun77 à dit:
Si dans la colonne A depuis la ligne 2 à la ligne 1000 , il y a dans une cellule le mot "OK"

Alors copier toutes les lignes dans la feuille "OK" à partir de la ligne 2.

Si un Ok (ou plus) dans la colonne A alors on copie les 1000 lignes dans l'autre onglet ... j'ai bien compris ?

Wisefun77 · 19 Août 2022

Bonjour Deadpool_CC,
Oui c'est bien cela.
Voici le fichier.
Merci beaucoup.

danielco · 19 Août 2022

Wisefun77 à dit:
Bonjour Deadpool_CC,
Oui c'est bien cela.
Voici le fichier.
Merci beaucoup.

Bonjour,

Essaie :

VB:

Sub test()
  With Sheets("Suivi")
    If IsNumeric(Application.Match("OK", .[A:A], 0)) Then
      .[2:1000].EntireRow.Copy Sheets("OK").[A2]
    End If
  End With
End Sub

Daniel

Deadpool_CC · 19 Août 2022

@danielco m'a devancé ...
bon et bien je vais pourvoir déco. ...lol

Wisefun77 · 22 Août 2022

Bonjour Danielco,

Je viens de tester ton code et cela copie toutes les lignes y compris celle que ne contiennent pas "OK".
Pas trop grave pour le moment.
Merci pour vos aides.

Deadpool_CC · 22 Août 2022

Wisefun77 à dit:
Je viens de tester ton code et cela copie toutes les lignes y compris celle que ne contiennent pas "OK".

cela m'étonnait aussi c'est pour cela que je t'avais demandé confirmation dans le post #3 et tu as bien valider qu'il fallait qu'on copie toutes les lignes si au moins 1 "Ok" ...

Wisefun77 · 22 Août 2022

Bonjour Deadpool_CC,
Désolé, je le suis encore mal exprimé.
J'aimerai que seulement les lignes comportant "OK" soient copiée.
Pardonnez mon erreur, la vieillesse étant.
Merci beaucoup.

TooFatBoy · 22 Août 2022

Bonjour,

Une proposition :

VB:

Sub CopierLignesOK()
'
    Application.ScreenUpdating = False

    ' Suppression de toutes les lignes de données du tableau "Tableau312" s'il n'est pas vide
    With Range("Tableau312")
        If Not .ListObject.DataBodyRange Is Nothing Then .Delete
    End With

    ' Désactivation du filtrage du tableau de la feuille "Suivi"
    Sheets("Suivi").ListObjects("Tableau3").Range.AutoFilter

    ' Filtrage des lignes dont la cellule de la première colonne est égale à "OK"
    Sheets("Suivi").ListObjects("Tableau3").Range.AutoFilter Field:=1, Criteria1:="OK"

    ' Copie des lignes filtrées du tableau
    Sheets("Suivi").ListObjects("Tableau3").DataBodyRange.Copy

    ' Collage des lignes copiées
    Range("Tableau312")(1).PasteSpecial Paste:=xlPasteValues

    ' Désactivation du filtrage du tableau de la feuille "Suivi"
    Sheets("Suivi").ListObjects("Tableau3").Range.AutoFilter Field:=1

    Application.ScreenUpdating = True

End Sub

danielco · 22 Août 2022

Bonjour,
Essaie :

VB:

Sub test()
  Dim Plage As Range
  With Sheets("Suivi")
    .ListObjects(1).Range.AutoFilter 1, "ok"
    Set Plage = .ListObjects(1).AutoFilter.Range
    If Application.Subtotal(103, Plage.Resize(, 1)) > 1 Then
      Plage.Offset(1).Resize(Plage.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy [OK!A2]
      .ListObjects(1).Range.AutoFilter
    End If
  End With
End Sub

TooFatBoy · 22 Août 2022

Wisefun77 à dit:
Ce code fait afficher de suite la MsgBox, et tourne en boucle, je dois arrêter le processus Excel via le gestionnaire des tâches.

Ou peut-être plus simplement par <Ctrl><Break>.

Wisefun77 · 23 Août 2022

Bonjour danielco, TooFatBoy,
Merci pour vos code.
J'ai testé celui de danielco, c'est super.
J'ai testé celui de TooFatBoy, c'est super.
Mais je ne sais pas pourquoi je le sens plus à l' aise avec le code de danielco.
Je vais étudier plus fond celui de TooFatBoy,
Et merci aussi pour l'astuce.

Wisefun77 à dit:
Wisefun77 à dit:

Ce code fait afficher de suite la MsgBox, et tourne en boucle, je dois arrêter le processus Excel via le gestionnaire des tâches.

Cliquez pour agrandir...

Ou peut-être plus simplement par <Ctrl><Break>.

Merci de tout cœur.

TooFatBoy · 23 Août 2022

Wisefun77 à dit:
Mais je ne sais pas pourquoi je me sens plus à l'aise avec le code de danielco.

J'ai l'habitude... apparemment c'est normal, ça le fait à tout le monde !...

C'est vraiment trop inzuste !

danielco · 23 Août 2022

TooFatBoy à dit:
J'ai l'habitude... apparemment c'est normal, ça le fait à tout le monde !...
C'est vraiment trop inzuste !

Bonjour @TooFatBoy
J'ai pourtant trouvé ton code plus complet que le mien, et plus simple, aussi. Et commenté, en plus !

Microsoft 365 Perfectionner une Macro

Wisefun77

XLDnaute Nouveau

danielco

vgendron

XLDnaute Barbatruc

Deadpool_CC

XLDnaute Accro

Wisefun77

XLDnaute Nouveau

Pièces jointes

danielco

XLDnaute Accro

Deadpool_CC

XLDnaute Accro

Wisefun77

XLDnaute Nouveau

Deadpool_CC

XLDnaute Accro

Wisefun77

XLDnaute Nouveau

TooFatBoy

XLDnaute Barbatruc

danielco

XLDnaute Accro

TooFatBoy

XLDnaute Barbatruc

Wisefun77

XLDnaute Nouveau

TooFatBoy

XLDnaute Barbatruc

danielco

XLDnaute Accro

Discussions similaires