XL 2010 Copy tableau et selon des valeurs vers la feuille suivante

[yahya belbachir]

Bonjour
j'ai réussi à à faire un code pour créer une nouvelle feuille avec incémentation de date et numérotation d'onglet,jusqu'à maintenant tout fonctionne très bien,je veux par la suite de copier tout le tableau comme il est, sauf les valeurs du colonne (K) si égale à 0 alors ne se recopie pas, et si valeur(K) plus grand que 0 se copie vers tableau du feuille (m2) dans la colonne (H), "colonne A vers A (B vers B) et colonne (K vers H)
est ce possible
merci
mon fichier çijoint:

 

[Dranreb]

Je pense qu'on pourrait le faire avec un seul tableau, non transposé à la fois entrée et sortie, et même qu'on devrait pouvoir faire la suppression des doublons en même temps que la suppression des payés.

 

[yahya belbachir]

je vais essayé,merci infiniment.

C'est vrai c'est ça ce que je cherche exactement,car ça va m'aider dans mon travail de routine journalier.si vous avez une idée à suggérer de votre part.

 

[Dranreb]

Je ne sais pas mais déjà la suppression des doublons seule je l'écrirais peut être à peu près comme ça :

Option Explicit
Sub SupprDoublons()
   Dim RngCàG As Range, TCàG(), RngM As Range, TM(), ClnLigAg As New Collection, Ag As String, Le&, Ls&, Lx&, C&
   Set RngCàG = ActiveSheet.[C5:G35]
   Set RngM = ActiveSheet.[M5:M35]
   TCàG = RngCàG.Value
   TM = RngM.Value
   On Error Resume Next
   For Le = 1 To UBound(TCàG, 1)
      If IsEmpty(TCàG(Le, 1)) Then
         Lx = 0
      Else
         Ag = TCàG(Le, 1)
         On Error Resume Next
         Lx = ClnLigAg.Item(Ag): If Err Then Lx = 0
         On Error GoTo 0
         If Lx = 0 Then ClnLigAg.Add Ls + 1, Ag
         End If
      If Lx = 0 Then
         Ls = Ls + 1
         For C = 1 To 5: TCàG(Ls, C) = TCàG(Le, C): Next C
         TM(Ls, 1) = TM(Le, 1)
      Else
         TM(Lx, 1) = TM(Lx, 1) + TM(Le, 1)
         End If
      Next Le
   Do: Ls = Ls + 1: If Ls > UBound(TCàG, 1) Then Exit Do
      For C = 1 To 5: TCàG(Ls, C) = Empty: Next C
      TM(Ls, 1) = Empty: Loop
   RngCàG.Value = TCàG
   RngM.Value = TM
   End Sub

À tester.
Mais j'ai l'impression qu'on pourrait y faire le report en même temps en chargeant dans TM la colonne R au lieu de la colonne M (mais en l'écrivant à la fin toujours en colonne M) et en ne faisant pas l'opération faite actuellement si Lx = 0 quand si TM(Le, 1) = 0 ou quelque chose comme ça…

 

[Dranreb]

En somme j'ai un peu l'impression que ce code ferait les 2 choses en même temps :

Option Explicit
Sub ReportEtSupprDoublons()
   Dim RngCàG As Range, TCàG(), TM(), ClnLigAg As New Collection, Ag As String, Le&, Ls&, Lx&, C&
   Set RngCàG = ActiveSheet.[C5:G35]
   TCàG = RngCàG.Value
   TM = ActiveSheet.[R5:R35]
   On Error Resume Next
   For Le = 1 To UBound(TCàG, 1)
      If IsEmpty(TCàG(Le, 1)) Then
         Lx = 0
      Else
         Ag = TCàG(Le, 1)
         On Error Resume Next
         Lx = ClnLigAg.Item(Ag): If Err Then Lx = 0
         On Error GoTo 0
         End If
      If Lx > 0 Then
         TM(Lx, 1) = TM(Lx, 1) + TM(Le, 1)
      ElseIf TM(Le, 1) > 0 Then
         Ls = Ls + 1
         For C = 1 To 5: TCàG(Ls, C) = TCàG(Le, C): Next C
         TM(Ls, 1) = TM(Le, 1)
         ClnLigAg.Add Ls, Ag
         End If
      Next Le
   Do: Ls = Ls + 1: If Ls > UBound(TCàG, 1) Then Exit Do
      For C = 1 To 5: TCàG(Ls, C) = Empty: Next C
      TM(Ls, 1) = Empty: Loop
   RngCàG.Value = TCàG
   ActiveSheet.[M5:M35].Value = TM
   End Sub

 

[yahya belbachir]

Je ne sais pas mais déjà la suppression des doublons seule je l'écrirais peut être à peu près comme ça :

Option Explicit
Sub SupprDoublons()
   Dim RngCàG As Range, TCàG(), RngM As Range, TM(), ClnLigAg As New Collection, Ag As String, Le&, Ls&, Lx&, C&
   Set RngCàG = ActiveSheet.[C5:G35]
   Set RngM = ActiveSheet.[M5:M35]
   TCàG = RngCàG.Value
   TM = RngM.Value
   On Error Resume Next
   For Le = 1 To UBound(TCàG, 1)
      If IsEmpty(TCàG(Le, 1)) Then
         Lx = 0
      Else
         Ag = TCàG(Le, 1)
         On Error Resume Next
         Lx = ClnLigAg.Item(Ag): If Err Then Lx = 0
         On Error GoTo 0
         If Lx = 0 Then ClnLigAg.Add Ls + 1, Ag
         End If
      If Lx = 0 Then
         Ls = Ls + 1
         For C = 1 To 5: TCàG(Ls, C) = TCàG(Le, C): Next C
         TM(Ls, 1) = TM(Le, 1)
      Else
         TM(Lx, 1) = TM(Lx, 1) + TM(Le, 1)
         End If
      Next Le
   Do: Ls = Ls + 1: If Ls > UBound(TCàG, 1) Then Exit Do
      For C = 1 To 5: TCàG(Ls, C) = Empty: Next C
      TM(Ls, 1) = Empty: Loop
   RngCàG.Value = TCàG
   RngM.Value = TM
   End Sub

À tester.
Mais j'ai l'impression qu'on pourrait y faire le report en même temps en chargeant dans TM la colonne R au lieu de la colonne M (mais en l'écrivant à la fin toujours en colonne M) et en ne faisant pas l'opération faite actuellement si Lx = 0 quand si TM(Le, 1) = 0 ou quelque chose comme ça…

enfin je vous remercie cela est mieux,ça a bien marché Mr Dranreb.
merci infiniment pour ce soutien.