Microsoft 365 Retourner message si compteur 0

[AD95]

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 !!!!!!!!

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

 

[Jacky67]

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,

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...

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

 

[AD95]

Bonjour Jacky67,

Merci pour ton retour problème résolu par contre pour le presse papier ça marche toujours pas je vais essayer de trouver un qui force la suppression du presse papier.

Encore merci pour ton aide bonne journée

 

[oguruma]

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]

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 :

Effacer le Presse-Papiers avec Excel VBA - Automate Excel

Effacer le Presse-Papiers avec Excel VBA Effacer le presse-papiers dans Excel VBA ne nécessite qu’une seule ligne de code : Application.CutCopyMode = False Cependant, il est différent du presse-papiers standard de Windows. Pour effacer le presse-papiers de Windows, vous pouvez utiliser la...

www.automateexcel.com