XL 2019 Réaliser une incrémentation de plusieurs plages de données.

[ApprentiCodeur]

Bonjour à tous,

J'ai réalisé un tableau dans lequel, chaque cellule fait partie d'un menu déroulant à cascade (c'est à dire que pour une ligne, la cellule D4 aura différentes options à proposer en fonction de la cellule précédente :C4). Ainsi ce tableau est défini par une plage range("B5:L24") et dans la feuille "Commande(s)"

Mon but est de couper coller les valeurs ce tableau dans un récap (situé dans une autre feuille "recap"). Cet autre tableau en "recap" est censé pouvoir acceuillir plusieurs tableaux à la suite de la feuille "commande(s)".

J'ai réussi à couper coller, via un bouton, mais j'aimerai, que quand je réalise plusieurs fois cette action (clic bouton), en plus de couper coller, les tableaux de "commandes" s'incrémentent en "reacp" mais à la suite (BD1,BD2).

J'ai essayé plusieurs options comme comme décomposer range() en rang(cells(+n),cells()) et en ajoutant une incrémentation (n) dans les coordonnées de cells(), mais cela me provoque des erreurs, et mon couper/coller ne fonctionne plus.

C'est assez compliqué à expliquer par message, mais je vous laisse en PJ mon projet si jamais un intéressé pourrait m'éclaircir ou me proposer des outils plus adaptés.

Je compte sur vos lumières merci par avance

 

[sylvanu]

Bonjour ApprentiCodeur,
Un essai en PJ avec :

Sub Transferer()
    Dim Bleu, DL%, NoBD%
    Application.ScreenUpdating = False
' Définition couleur pour une matrice sur deux
    Bleu = RGB(230, 255, 255)   ' couleur à adapter si besoin
' Calcul ligne où coller datas
    DL = 1 + Sheets("Recap").Range("B65500").End(xlUp).Row
    If DL < 3 Then DL = 3 ' cas où tableau Recap vide
' Copie du format quadrillage à la fin de Recap
    Sheets("Recap").Select
    [Quadrillage].Copy
    Cells(DL, "B").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' Copier les valeurs
    Sheets("Recap").Range("C" & DL & ":M" & DL + 19) = [Données].Value
' Incrément des BD
    NoBD = 1 + Val(Mid(Sheets("Recap").Cells(DL - 1, "B"), 3))
    Sheets("Recap").Range("B" & DL & ":B" & DL + 19) = "BD" & NoBD
' Mise en couleurs une matrice sur deux
    If Sheets("Recap").Cells(DL - 1, "B").Interior.Color <> Bleu Then
        Sheets("Recap").Range("B" & DL & ":M" & DL + 19).Interior.Color = Bleu
    Else
        Sheets("Recap").Range("B" & DL & ":M" & DL + 19).Interior.Color = vbWhite
    End If
' Repositionnement curseur
    Sheets("Recap").Range("B" & DL).Select
    Sheets("Commande(s)").Select
End Sub

La mise en couleur une matrice sur deux permet une meilleure lisibilité de Recap. ( à mon avis )

 

[ApprentiCodeur]

Bonjour et un grand merci à toi Sylvanu,
C'est encore mieux que ce dont je pouvais espérer ! J'ai encore beaucoup à apprendre !
L'idée de changer de couleur pour une matrice sur deux est très astucieux. De plus je n'ai pas à marquer le numéro de bandereau dans mon "recap" c'est super!
Merci beaucoup pour cette solution.
J'ai juste une petite question, est ce que je dois modifier le select (ci-dessous) pour que le BD1 de mon "recap" ne soit pas sélectionné à chaque transfert ?

' Repositionnement curseur
Sheets("Recap").Range("B" & DL).Select
Sheets("Commande(s)").Select


Encore merci dans l'attente de ton retour

Cdt

 

[sylvanu]

Comme tout se passe sur la feuille Recap, il y a effectivement plus simple :

Sub Transferer()
    Dim Bleu, DL%, NoBD%
    Application.ScreenUpdating = False
' On se met sur la feuille Recap
    Sheets("Recap").Select
' Définition couleur pour une matrice sur deux
    Bleu = RGB(230, 255, 255)   ' couleur à adapter si besoin
' Calcul ligne où coller datas
    DL = 1 + Range("B65500").End(xlUp).Row
    If DL < 3 Then DL = 3 ' cas où tableau Recap vide
' Copie du format quadrillage à la fin de Recap
    [Quadrillage].Copy
    Cells(DL, "B").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' Copier les valeurs
    Range("C" & DL & ":M" & DL + 19) = [Données].Value
' Incrément des BD
    NoBD = 1 + Val(Mid(Cells(DL - 1, "B"), 3))
    Range("B" & DL & ":B" & DL + 19) = "BD" & NoBD
' Mise en couleurs une matrice sur deux
    If Cells(DL - 1, "B").Interior.Color <> Bleu Then
        Range("B" & DL & ":M" & DL + 19).Interior.Color = Bleu
    Else
        Range("B" & DL & ":M" & DL + 19).Interior.Color = vbWhite
    End If
' Repositionnement curseur
    Range("B" & DL).Select
    Sheets("Commande(s)").Select
End Sub

De cette façon tous les Sheets("Recap") deviennent inutiles.
Ca été fait à l'arraché sans souci d'optimisation.

 

[ApprentiCodeur]

Plutôt qualitatif pour un programme "à l'arrache"
Encore merci pour cette grande aide.

Bonne journée

Cdt