Message box avec le nbr de ligne transferer

Bonjour ,

Je souhaiterai améliorée une macro , pour cela il faudrait que j'insère un message box me donnant le nombre de ligne transférer.

Auriez-vous une idée , à conseillée, à me communiquée ? , je ne ses pas pas ou commencée ni ou l'insérer dans ma macro .

Voici le code

Sub Transfert_LLS_Suivi()
  Dim Dlig As Long, Lig As Long, nLig As Long
  Dim ShtS As Worksheet, ShtD As Worksheet
  Dim Dico As Object, sKey As String
  ' Définir les feuilles
  Set ShtS = ThisWorkbook.Sheets("LLS")
  Set ShtD = ThisWorkbook.Sheets("SUIVI")
  ' Dernière ligne remplie de la feuille source
  Dlig = ShtS.Range("A" & Rows.Count).End(xlUp).Row
  ' Nouvelles ligne de la feuille de destination
  nLig = ShtD.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row
  ' Définir le dictionnaire pour les doublons et le remplir
  Set Dico = CreateObject("Scripting.Dictionary")
  With ShtD
    For Lig = 2 To nLig - 1
    sKey = .Range("O" & Lig).Value
    Dico(sKey) = ""
    Next Lig
  End With
  With ShtS
    For Lig = 2 To Dlig
      If .Rows(Lig).Hidden = False Then
      sKey = .Range("N" & Lig).Value
        ' Si clé n'existe pas
        If Not Dico.Exists(sKey) Then
          ' L'ajouter
          Dico.Add sKey, ""
          ' Copier les données
          ShtD.Range("B" & nLig).Value = ShtS.Range("A" & Lig).Value
          ShtD.Range("C" & nLig).Value = ShtS.Range("C" & Lig).Value
          ShtD.Range("D" & nLig).Value = ShtS.Range("B" & Lig).Value
          ShtD.Range("E" & nLig).Value = ShtS.Range("D" & Lig).Value
          ShtD.Range("F" & nLig).Value = ShtS.Range("E" & Lig).Value
          ShtD.Range("G" & nLig).Value = ShtS.Range("I" & Lig).Value
          ShtD.Range("H" & nLig).Value = ShtS.Range("J" & Lig).Value

          ' Incrémenter les nouvelle lignes
          nLig = nLig + 1
        End If
      End If
    Next Lig
  End With
  Set ShtD = Nothing: Set ShtS = Nothing

   'message box de confirmation
  MsgBox "Transfert OK !", vbInformation, "Terminée !"

End Sub

Merci d'avance

Bonne journée

Cordialement

Je pense qu'il faut faire un CALCULATE sur le dico des doublons ?

Hello,

Pour compter le nombre d'éléments dans un dico c'est :

Dico.count

Donc peut être comme ceci :

Sub Transfert_LLS_Suivi()
  Dim Dlig As Long, Lig As Long, nLig As Long
  Dim ShtS As Worksheet, ShtD As Worksheet
  Dim Dico As Object, sKey As String
  ' Définir les feuilles
  Set ShtS = ThisWorkbook.Sheets("LLS")
  Set ShtD = ThisWorkbook.Sheets("SUIVI")
  ' Dernière ligne remplie de la feuille source
  Dlig = ShtS.Range("A" & Rows.Count).End(xlUp).Row
  ' Nouvelles ligne de la feuille de destination
  nLig = ShtD.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row
  ' Définir le dictionnaire pour les doublons et le remplir
  Set Dico = CreateObject("Scripting.Dictionary")
  With ShtD
    For Lig = 2 To nLig - 1
    sKey = .Range("O" & Lig).Value
    Dico(sKey) = ""
    Next Lig
  End With
  With ShtS
    For Lig = 2 To Dlig
      If .Rows(Lig).Hidden = False Then
      sKey = .Range("N" & Lig).Value
        ' Si clé n'existe pas
        If Not Dico.Exists(sKey) Then
          ' L'ajouter
          Dico.Add sKey, ""
          ' Copier les données
          ShtD.Range("B" & nLig).Value = ShtS.Range("A" & Lig).Value
          ShtD.Range("C" & nLig).Value = ShtS.Range("C" & Lig).Value
          ShtD.Range("D" & nLig).Value = ShtS.Range("B" & Lig).Value
          ShtD.Range("E" & nLig).Value = ShtS.Range("D" & Lig).Value
          ShtD.Range("F" & nLig).Value = ShtS.Range("E" & Lig).Value
          ShtD.Range("G" & nLig).Value = ShtS.Range("I" & Lig).Value
          ShtD.Range("H" & nLig).Value = ShtS.Range("J" & Lig).Value

          ' Incrémenter les nouvelle lignes
          nLig = nLig + 1
        End If
      End If
    Next Lig
  End With
  Set ShtD = Nothing: Set ShtS = Nothing

   'message box de confirmation
  MsgBox "Transfert OK ! " & Dico.count & " transferts effectués.", vbInformation, "Terminée !"

End Sub

Bonjour Rag,

Merci pour ton retour ,

Effectivement je ne connaissait pas cette fonction . Mais elle me dépanne bien pour ma problématique .

En recherchant un peu j'ai trouver le COMPARE ou DICO INVERSE ? pense tu que je peut le traduire on disant je compte le nombre de ligne qui étai non présente avant le transfert = non présent dans le dico

Merci encore

Bonne journée

Hello,

Je comprends pas trop ce que tu cherches à faire ... dsl

Tu peux être un peu + clair stp

Rechercher des sujets similaires à "message box nbr ligne transferer"