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

yahya belbachir

XLDnaute Junior
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:
 

Fichiers joints

Robert

XLDnaute Barbatruc
Bonjour Yahya, bonjour le forum,

J'ai modifié la macro initiale. Regarde si ça convient :

VB:
Sub DupliquerFeuille()
Dim Num As Integer
Dim I As Byte

Num = CInt(Right(ActiveSheet.Name, Len(ActiveSheet.Name) - 1))
ActiveSheet.Copy after:=ActiveSheet
With ActiveSheet
    .Name = "M " & Num + 1
    .[K2] = [K2] + 1
    .[E2] = [E2] + 1
    For I = 5 To 25
        .Cells(I, "H").Value = IIf(.Cells(I, "K").Value = 0, "", .Cells(I, "K").Value)
        .Cells(I, "K").Value = ""
    Next I
End With

End Sub
 

yahya belbachir

XLDnaute Junior
Bonjour Yahya, bonjour le forum,

J'ai modifié la macro initiale. Regarde si ça convient :

VB:
Sub DupliquerFeuille()
Dim Num As Integer
Dim I As Byte

Num = CInt(Right(ActiveSheet.Name, Len(ActiveSheet.Name) - 1))
ActiveSheet.Copy after:=ActiveSheet
With ActiveSheet
    .Name = "M " & Num + 1
    .[K2] = [K2] + 1
    .[E2] = [E2] + 1
    For I = 5 To 25
        .Cells(I, "H").Value = IIf(.Cells(I, "K").Value = 0, "", .Cells(I, "K").Value)
        .Cells(I, "K").Value = ""
    Next I
End With

End Sub
merci ROBERT pour la réponse,
pour le copie à la feuille suivante ça fonctionne parfait, mais si la feuille source dans la colonne (K) égale à zero est possible de ne pas le copier?
j'ai fais dans mon exemple une copie manuelle dans la feuille (M 1).
merci
 

Fichiers joints

Robert

XLDnaute Barbatruc
Re,

Dans ce cas, essaie comme ça :

VB:
Sub DupliquerFeuille()
Dim Num As Integer
Dim I As Integer

Num = CInt(Right(ActiveSheet.Name, Len(ActiveSheet.Name) - 1))
ActiveSheet.Copy after:=ActiveSheet
With ActiveSheet
    .Name = "M " & Num + 1
    .[K2] = [K2] + 1
    .[E2] = [E2] + 1
    For I = 25 To 5 Step -1
        If Not .Cells(I, "K") = "" Then
            If .Cells(I, "K").Value = 0 Then
                .Rows(I).Delete
            Else
                .Cells(I, "H").Value = .Cells(I, "K").Value
                .Cells(I, "K").Value = ""
            End If
        End If
    Next I
End With
End Sub
 

yahya belbachir

XLDnaute Junior
Re,

Dans ce cas, essaie comme ça :

VB:
Sub DupliquerFeuille()
Dim Num As Integer
Dim I As Integer

Num = CInt(Right(ActiveSheet.Name, Len(ActiveSheet.Name) - 1))
ActiveSheet.Copy after:=ActiveSheet
With ActiveSheet
    .Name = "M " & Num + 1
    .[K2] = [K2] + 1
    .[E2] = [E2] + 1
    For I = 25 To 5 Step -1
        If Not .Cells(I, "K") = "" Then
            If .Cells(I, "K").Value = 0 Then
                .Rows(I).Delete
            Else
                .Cells(I, "H").Value = .Cells(I, "K").Value
                .Cells(I, "K").Value = ""
            End If
        End If
    Next I
End With
End Sub
merci infiniment cela fonctionne bien comme je veux
,je vaisessayer de faire un clear contents pour les colonnes (C:F)
 

yahya belbachir

XLDnaute Junior
Re,

Dans ce cas, essaie comme ça :

VB:
Sub DupliquerFeuille()
Dim Num As Integer
Dim I As Integer

Num = CInt(Right(ActiveSheet.Name, Len(ActiveSheet.Name) - 1))
ActiveSheet.Copy after:=ActiveSheet
With ActiveSheet
    .Name = "M " & Num + 1
    .[K2] = [K2] + 1
    .[E2] = [E2] + 1
    For I = 25 To 5 Step -1
        If Not .Cells(I, "K") = "" Then
            If .Cells(I, "K").Value = 0 Then
                .Rows(I).Delete
            Else
                .Cells(I, "H").Value = .Cells(I, "K").Value
                .Cells(I, "K").Value = ""
            End If
        End If
    Next I
End With
End Sub
Re Bonjour Mr Robert
veuillez m'excuser de vous déranger,
concernant le macro fonctionne bien,faisant copie par la suite de la feuille suivante,le tableau s'efface,j'ai tenté plusieurs fois sans résultat de garder le tableau à sa forme dans la feuille 2 comme le tableau de la feuille 1.
 

Fichiers joints

Robert

XLDnaute Barbatruc
Re,

Peut-être comme ça :

VB:
Sub DupliquerFeuille()
Dim Num As Integer
Dim I As Integer

Num = CInt(Right(ActiveSheet.Name, Len(ActiveSheet.Name) - 1))
ActiveSheet.Copy after:=ActiveSheet
With ActiveSheet
    .Name = "M " & Num + 1
    .[K2] = [K2] + 1
    .[E2] = [E2] + 1
    For I = 25 To 5 Step -1
        If Not .Cells(I, "K") = "" Then
            If .Cells(I, "K").Value = 0 And .Cells(I, "A").Value <> "TOTAL" Then
                .Rows(I).Delete
            Else
                .Cells(I, "H").Value = .Cells(I, "K").Value
                .Cells(I, "K").Value = ""
            End If
        End If
    Next I
End With
End Sub
 

yahya belbachir

XLDnaute Junior
Re,

Peut-être comme ça :

VB:
Sub DupliquerFeuille()
Dim Num As Integer
Dim I As Integer

Num = CInt(Right(ActiveSheet.Name, Len(ActiveSheet.Name) - 1))
ActiveSheet.Copy after:=ActiveSheet
With ActiveSheet
    .Name = "M " & Num + 1
    .[K2] = [K2] + 1
    .[E2] = [E2] + 1
    For I = 25 To 5 Step -1
        If Not .Cells(I, "K") = "" Then
            If .Cells(I, "K").Value = 0 And .Cells(I, "A").Value <> "TOTAL" Then
                .Rows(I).Delete
            Else
                .Cells(I, "H").Value = .Cells(I, "K").Value
                .Cells(I, "K").Value = ""
            End If
        End If
    Next I
End With
End Sub
merci Mr Robert,même problème,le tableau se réduit.
merci
 

Robert

XLDnaute Barbatruc
Re,

Pas chez moi, du coup je ne sais pas ce que je dois modifier. Envoie moi un fichier avec minimum 5 tableaux (générés par la macro) et en indiquant clairement, dans chaque onglet, ce qui ne va pas pour que je comprenne...
 

yahya belbachir

XLDnaute Junior
Re,

Pas chez moi, du coup je ne sais pas ce que je dois modifier. Envoie moi un fichier avec minimum 5 tableaux (générés par la macro) et en indiquant clairement, dans chaque onglet, ce qui ne va pas pour que je comprenne...
essayez de voir ce fichier que j'ai fais,j'ai tenté de rajouter quelque chose dans le code pour que le macro ne diminue pas le tableau, je vous explique
si une ligne est supprimé dans le feuille suivante,est possible que le tableau rajoute une ligne au dessous:
exemple le tableau s'arrête dans la ligne (26),alors ce que je veux dans la feuille suivante que le tableau s’arrête dans la ligne (26) ("TOTAL")
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
Bonjour.
Définitivement, NON !
De nos jours ça ne se fait absolument plus de laisser exprès des lignes vide dans un tableau.
Au contraire on met les plages qui les couvrent sous forme de tableaux à références structurées (beaucoup raccourcissent ça en 'tableaux structurés', ce qui est un terme que je n'ai jamais vue employé par Microsoft), lesquels n'ont que des lignes utiles mais peuvent se terminer par une ligne Total dont la position est donc variable.
Je ne comprend pas exactement ce que vous souhaitez. Ce que j'ai plus ou moins compris, à travers vos classeurs joints et une conversation que vous m'avez adressée, c'est que vous voulez reporter dans la nouvelle feuille les impayés, grosso modo, en une liste de noms sans doublon. Mais dans ce cas la logique voudrait qu'en même temps les colonnes Vente1 à Vente4 et les paiements soient remis à zéro dans la nouvelle feuille, non ?
 
Dernière édition:

yahya belbachir

XLDnaute Junior
Bonjour.
Définitivement, NON !
De nos jours ça ne se fait absolument plus de laisser exprès des lignes vide dans un tableau.
Au contraire on met les plages qui les couvrent sous forme de tableaux à références structurées (beaucoup raccourcissent ça en 'tableaux structurés', ce qui est un terme que je n'ai jamais vue employé par Microsoft), lesquels n'ont que des lignes utiles mais peuvent se terminer par une ligne Total dont la position est donc variable.
Je ne comprend pas exactement ce que vous souhaitez. Ce que j'ai plus ou moins compris, à travers vos classeurs joints et une conversation que vous m'avez adressée, c'est que vous voulez reporter dans la nouvelle feuille les impayés, grosso modo, en une liste de noms sans doublon. Mais dans ce cas la logique voudrait qu'en même temps les colonnes Vente1 à Vente4 et les paiements soient remis à zéro dans la nouvelle feuille, non ?
Bosoir Dranreb
je vais essayé de vous envoyé mon classeur que j'ai réaliser à travers une copie de ce code,j'ai réussi à le faire il me reste un petit probléme,je vais vous envoyé mon classeur pour voir ce qu'il me manque
et merci pour votre soutien
 

yahya belbachir

XLDnaute Junior
Bosoir Dranreb
je vais essayé de vous envoyé mon classeur que j'ai réaliser à travers une copie de ce code,j'ai réussi à le faire il me reste un petit probléme,je vais vous envoyé mon classeur pour voir ce qu'il me manque
et merci pour votre soutien
Bonjour.
Définitivement, NON !
De nos jours ça ne se fait absolument plus de laisser exprès des lignes vide dans un tableau.
Au contraire on met les plages qui les couvrent sous forme de tableaux à références structurées (beaucoup raccourcissent ça en 'tableaux structurés', ce qui est un terme que je n'ai jamais vue employé par Microsoft), lesquels n'ont que des lignes utiles mais peuvent se terminer par une ligne Total dont la position est donc variable.
Je ne comprend pas exactement ce que vous souhaitez. Ce que j'ai plus ou moins compris, à travers vos classeurs joints et une conversation que vous m'avez adressée, c'est que vous voulez reporter dans la nouvelle feuille les impayés, grosso modo, en une liste de noms sans doublon. Mais dans ce cas la logique voudrait qu'en même temps les colonnes Vente1 à Vente4 et les paiements soient remis à zéro dans la nouvelle feuille, non ?
essayer d'ouvrir mon test origine ce que je veux exactement,et c'est vrai vous avez bien compris ce que je veux exactement, c'est de reporter les vente impayées dans la page suivante
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
Bonjour.
Essayez en rangeant le numéro de ligne x dans l'item de votre collection plutôt que d'y répéter le clé: ça vous évitera de l'y rechercher pour cumuler. Ce ne serait vraiment pas possible de mettre ça sous forme de tableau ?
 

Dranreb

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

Dranreb

XLDnaute Barbatruc
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…
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
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

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

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas