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

yahya belbachir · 2 Décembre 2019

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 · 9 Décembre 2019

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 · 9 Décembre 2019

yahya belbachir à dit:
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 · 9 Décembre 2019

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

VB:

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 · 9 Décembre 2019

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

VB:

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 · 9 Décembre 2019

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

VB:

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.

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

yahya belbachir

XLDnaute Occasionnel

Pièces jointes

Dranreb

XLDnaute Barbatruc

yahya belbachir

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

yahya belbachir

XLDnaute Occasionnel

Discussions similaires