VBA pour tenue de registre

Bonjour à tous,

Je débute en VBA. Je cherche à réaliser le scénario expliqué dans mes fichiers ci-dessous avec des macros.

Ci-dessous :

- un fichier avec la situation de départ avant exécution des macros

- un fichier avec le résultat escompté après exécution des macros

J'espère que l'exemple est clair. Merci pour votre aide :)

Joris

Bonjour,

affecte la macro suivante à tes 2 boutons

Sub transfert()
    if ActiveSheet.ListObjects(tableau).DataBodyRange is nothing then exit sub
    tableau = "Commandes_" & Split(ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text, "_")(1)
    With Sheets("Registre_Commandes_Validées").ListObjects(1)
        .ListRows.Add
        ActiveSheet.ListObjects(tableau).DataBodyRange.Copy
        .DataBodyRange.Cells(.ListRows.Count, 1).PasteSpecial Paste:=xlPasteValues
        ActiveSheet.ListObjects(tableau).DataBodyRange.Delete
    End With
End Sub

Salut Steelson;

Merci pour ta réponse.

J'ai un soucis dans l'affectation aux boutons. Pourrais-tu me renvoyer le fichier avec les affectations ? Ca me serait d'une grande aide

Merci bcp

Steelson a écrit :

24cas-exemple-situtationdedepart.xlsm (22.24 Ko)

Salut Steelson,

Merci pour ton fichier. C'est presque ce qu'il me faut, il faudrait juste que les formules dans mes deux tableaux ne soient pas écrasées après exécution des macros.

Si tu pouvais encore me corriger ça ce serait super

Merci bcp d'avance

Joris

Et justement, elles y étaient mais quand j'ai vu ton résultat final il s'agissait de valeurs.

OK je reviens à la situation antérieure.

Sub transfert()
    client = Split(ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text, "_")(1)
    tableau = "Commandes_" & client
    Set donnees = ActiveSheet.ListObjects(tableau).DataBodyRange
    If donnees Is Nothing Then Exit Sub
    With Sheets("Registre_Commandes_Validées")
        With .ListObjects(1)
            .ListRows.Add
            ligne = .ListRows.Count
            donnees.Copy Destination:=.DataBodyRange.Cells(.ListRows.Count, 1)
            donnees.Delete
            .DataBodyRange.Replace What:=tableau, Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            For i = ligne To .ListRows.Count
                .DataBodyRange.Cells(i, 5) = client
            Next
        End With
    End With
End Sub

Steelson a écrit :

Sub transfert()
    client = Split(ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text, "_")(1)
    tableau = "Commandes_" & client
    Set donnees = ActiveSheet.ListObjects(tableau).DataBodyRange
    If donnees Is Nothing Then Exit Sub
    With Sheets("Registre_Commandes_Validées")
        With .ListObjects(1)
            .ListRows.Add
            ligne = .ListRows.Count
            donnees.Copy Destination:=.DataBodyRange.Cells(.ListRows.Count, 1)
            donnees.Delete
            .DataBodyRange.Replace What:=tableau, Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            For i = ligne To .ListRows.Count
                .DataBodyRange.Cells(i, 5) = client
            Next
        End With
    End With
End Sub

13cas-exemple-situtationdedepart.xlsm (21.75 Ko)

Salut Steelson,

Merci pour ta nouvelle macro mais ca ne change rien par rapport à la précédente, les formules sont à nouveau écrasées quand j'exécute la macro.

Tu as une solution ?

Salutations!

Si ceci n'est pas une formule, je ne sais pas ce que c'est !

sauf pour la colonne Client, impossible de récupérer le formule qui pointe vers une zone fixe de l'autre page

donc pour colonnes B et D, c'set ok, pour E je peux le faire aussi !

Sub transfert()
    client = Split(ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text, "_")(1)
    tableau = "Commandes_" & client
    Set donnees = ActiveSheet.ListObjects(tableau).DataBodyRange
    If donnees Is Nothing Then Exit Sub
    With Sheets("Registre_Commandes_Validées")
        With .ListObjects(1)
            .ListRows.Add
            ligne = .ListRows.Count
            donnees.Copy Destination:=.DataBodyRange.Cells(.ListRows.Count, 1)
            donnees.Delete
            .DataBodyRange.Replace What:=tableau, Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            For i = ligne To .ListRows.Count
                .DataBodyRange.Cells(i, 5).Replace What:="$B$", Replacement:="Commandes!$B$", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            Next
        End With
    End With
End Sub

Steelson a écrit :

Si ceci n'est pas une formule, je ne sais pas ce que c'est !

sauf pour la colonne Client, impossible de récupérer le formule qui pointe vers une zone fixe de l'autre page

donc pour colonnes B et D, c'set ok, pour E je peux le faire aussi !

Salut Steelson,

On s´est pas compris sur ce coup je crois

Aprés exécution des macros, je souhaite que mes formules restent dans mes Tableaux "Commandes_Client1" et "Commandes_Client2" et que les valeurs dans le tableau "Registre" soient juste des valeurs.

En PJ le fichier que je souhaite obtenir après exécution des macros

On va y arriver

Merci :)

Alors je reprends le même fichier et je t'explique ...

Ce n'est pas parce que tu ne vois pas ou plus les formules dans un tableau structuré qu'elles ne sont pas actives. C'est magique !

Après avoir transféré, tape un article quelconque et tu verres ...

Steelson a écrit :

Alors je reprends le même fichier et je t'explique ...

18cas-exemple-situtationdedepart.xlsm (22.24 Ko)

Ce n'est pas parce que tu ne vois pas ou plus les formules dans un tableau structuré qu'elles ne sont pas actives. C'est magique !

Après avoir transféré, tape un article quelconque et tu verres ...

Effectivement, je n'avais pas essayé, je suis bluffé

C'est parfait! ! Merci beaucoup pour ton aide

A+

Joris