Microsoft 365 Retourner message si compteur 0

AD95

XLDnaute Junior
Bonjour la team,

J'aimerai savoir comment rajouter dans mon code qui copie des lignes en parcourant toutes les feuilles à partir de la 8eme avec la condition si la la colonne A est = à "0 " alors copié la ligne et la coller dans une autre feuille avec dans MsgBox le nombre de ligne copié
Là j'ai besoin de lui dire que s'il n'a rien copié donc "0" copie (si le résultat retourne 0) alors mettre un message "Pensez à exécuter de nouveau la 1 ère Macro pour charger les données"

Aussi j'aimerai savoir comment forcé la suppression du presse papier car la commande que j'ai mis semble ne rien faire

' Effacer le Presse-papiers
Application.CutCopyMode = False
************

Merci d'avance pour votre expertise !!!!!!!!


VB:
Sub Ext()


    Dim ws As Worksheet
    Dim wsITB As Worksheet
    Dim lastRow As Long, destRow As Long
    Dim i As Long


    'Réduire le temps d'exécution
Application.ScreenUpdating = False


    'Message de téléchargement en cours"
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Traitement en cours veuillez patienter svp..."

        ' Effacer le Presse-papiers
    Application.CutCopyMode = False
  


        'Position de la feuille
    Sheets("Ext").Select

ActiveSheet.Cells.Clear

    ' Spécifiez le nom de la feuille Ext
    Set wsITB = Sheets("Exter")
  
        ' Supprime les lignes de la 1ere à la dernière
    wsITB.Rows("1:" & wsITB.Rows.Count).Delete

  
    ' Parcourez toutes les feuilles à partir de la 8ème
    For Each ws In Worksheets
        If ws.Index >= 8 Then
            ' Trouvez la dernière ligne dans la feuille en cours
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
      
          
            ' Parcourez la colonne A et copiez les lignes contenant 0
            For i = 1 To lastRow
                If ws.Cells(i, 1).Value = 0 Then
                    ' Copiez la ligne à la dernière ligne de la feuille Ext
                    destRow = wsITB.Cells(wsITB.Rows.Count, "A").End(xlUp).Row + 1
                    ws.Rows(i).Copy wsITB.Rows(destRow)
                End If
            Next i
        End If
    Next ws
  
            ' Effacer le Presse-papiers
    Application.CutCopyMode = False
 
Dernière édition:

Jacky67

XLDnaute Barbatruc
Bonjour la team,

J'aimerai savoir comment rajouter dans mon code qui copie des lignes en parcourant toutes les feuilles à partir de la 8eme avec la condition si la la colonne A est = à "0 " alors copié la ligne et la coller dans une autre feuille avec dans MsgBox le nombre de ligne copié
Là j'ai besoin de lui dire que s'il n'a rien copié donc "0" copie (si le résultat retourne 0) alors mettre un message "Pensez à exécuter de nouveau la 1 ère Macro pour charger les données"

Aussi j'aimerai savoir comment forcé la suppression du presse papier car la commande que j'ai mis semble ne rien faire
Bonjour,
Sans classeur test et avec le code modifié comme ci-dessous
Perso pour vider le presse papier, j'utilise cette méthode,
VB:
Application.CutCopyMode = False
Cells(Application.Rows.Count, Application.Columns.Count).Copy
Application.CutCopyMode = False
Si cela ne convient pas , il y a des usines à gaz qui le font différemment, faire une recherche ici ou sur le web
A tester...
Code:
Sub Ext()


    Dim ws As Worksheet
    Dim wsITB As Worksheet
    Dim lastRow As Long, destRow As Long
    Dim i As Long
    Dim Compteur&, total&, Msg$

    'Réduire le temps d'exécution
    Application.ScreenUpdating = False


    'Message de téléchargement en cours"
  '  oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.StatusBar = "Traitement en cours veuillez patienter svp..."

    ' Effacer le Presse-papiers
    Application.CutCopyMode = False

    'Position de la feuille
    Sheets("Ext").Select
    ActiveSheet.Cells.Clear
    ' Spécifiez le nom de la feuille Ext
    Set wsITB = Sheets("Exter")

    ' Supprime les lignes de la 1ere à la dernière
    wsITB.Rows("1:" & wsITB.Rows.Count).Delete


    ' Parcourez toutes les feuilles à partir de la 8ème
    For Each ws In Worksheets
        If ws.Index >= 8 Then
            ' Trouvez la dernière ligne dans la feuille en cours
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

            ' Parcourez la colonne A et copiez les lignes contenant 0
            For i = 1 To lastRow
                If ws.Cells(i, 1).Value = 0 And ws.Cells(i, 1) <> "" Then    'Vraiment égale à 0(zéro)
                    ' Copiez la ligne à la dernière ligne de la feuille Ext
                    destRow = wsITB.Cells(wsITB.Rows.Count, "A").End(xlUp).Row + 1
                    ws.Rows(i).Copy wsITB.Rows(destRow)
                    Compteur = Compteur + 1    'incrémente le compteur
                End If
            Next i
            Msg = Msg & ws.Name & " copie= " & Compteur & " ligne(s)" & vbLf
            total = total + Compteur
            Compteur = 0
        End If
    Next ws
    If total = 0 Then Msg = Msg & vbLf & "Pensez à exécuter de nouveau la 1 ère Macro pour charger les données."
    MsgBox Msg, , "Information" ' affiche le msgbox
    ' Effacer le Presse-papiers
    Application.CutCopyMode = False
    Cells(Application.Rows.Count, Application.Columns.Count).Copy
    Application.CutCopyMode = False
End Sub
 
Dernière édition:

oguruma

XLDnaute Occasionnel
Bonjour dans le style "gaz factory" il y a les API windows pour vider le pressPapier. Cependant bien que l'appel des api peut être la solution tu rerstes néanmoins à la merci de Microsoft qui peut changer le fonctionnement et les appels de ses API et là binnnnn ton code est à revoir. Donc API=Oui mais quand on n'a pas d'autres choix et sous la menace de maintenance du code ;)
 

AD95

XLDnaute Junior
Bonjour oguruma,

Effectivement, c'est ce que je lis un partout j'ai même trouvé une petite commande sur un site mais sans succès non plus.

voici le lien si ça peut intéresser quelqu'un :

1703603785958.png
 

Discussions similaires

Réponses
3
Affichages
132
Réponses
0
Affichages
196

Statistiques des forums

Discussions
312 803
Messages
2 092 251
Membres
105 316
dernier inscrit
cyrille225