XL 2013 VBA - Dupliquer ligne et fusionner certaines colonnes

Leché

XLDnaute Junior
Bonjour à tous et à toutes,

Je me permets de vous solliciter afin de pallier à mon problème, ayant peu (voir quasiment aucune..) base en VBA.

A partir d’une base de donnée, je dois mettre en place une fiche de travail, appelant l’ensemble des références nécessaires (REF 1) ainsi que les sous ref qui la compose. (Sous ref 1 ; Sous ref 2)

1.png


Mon souci est, que les codes-barres sont faussés. Le fait d’avoir Sousref1 et sousref2 dans la même cellule, renvoi un code barre différent que si j’avais sousref1 dans une cellule et sousref2 dans une autre.

Ma problématique est donc de dupliquer la ligne lorsque j’ai plusieurs sous ref dans la même cellule et de garder une partie des info par ligne.

A savoir, dans les cellules ce n’est pas du texte brut, mais des formules qui renvoient des données depuis une base de donnée (qui n’est pas modifiable)

Aujourd’hui j’ai le code suivant (que j’ai trouvé sur internet, à voir à la fin du post) me permettant de dupliquer mes lignes via une message box me demandant le nombre de fois qu’il faut dupliquer la ligne) ce qui donne :

2.png


Il faudrait donc une macro qui permet de :
  • Dupliquer de X fois la ligne en question (X = nb de sous ref) en collage texte
  • Pour chaque ligne dupliquée, il faudrait garder seulement une Sous ref
  • Fusionner et centrer l’ensemble des lignes dupliquées sauf la colonne Sous ref 1 et Sous ref 2 et celles des codes-barres (le top aurait été de sortir aussi les autres infos des autres colonnes, mais je vais y aller petit à petit)
  • Remettre dans la cellule du code barre *Sousref* afin de sortir le code barre via une police spéciale (comme on a collé en texte brut)
  • Supprimer la ligne qui a été dupliqué (celle avec les formules)

Afin de sortir la mise en page suivante :
3.png


VB:
Sub dupliquerlignes2()
Dim lignes As Integer
Dim debut As Integer
lignes = InputBox("Nombre de lignes à dupliquer ?")
For debut = 4 To lignes
With ActiveCell.EntireRow
.Offset(debut, 0).Insert Shift:=xlDown
.Copy Destination:=.Offset(debut, 0)
End With
Next debut
End Sub


Je reste attentif a vos réponses :)
Bonne soirée
Cordialement,
 

Discussions similaires

Haut Bas