VBA Excel - Copier des lignes si condition

  • Initiateur de la discussion Initiateur de la discussion jacktbio2
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

J

jacktbio2

Guest
Bonjour,

Je sollicite votre aide pour réaliser une macro dans Excel 2003.

Voici mon tableau :

A ......................... B
Fruit ................ Banane - L:9900 LE5:9907 10cl:9920
Légumes ........ Courgette - 30cl:3043 L:4356
Conserve ....... Sardine - L:8760 L:7883 30cl:1289 40cl:9912 40cl:9913

Je souhaiterai que pour chaque code à 4 chiffres qui suivent les ":", une ligne soit créée en dessous en recopiant la ligne et en indiquant dans la colonne C le code à 4 chiffres.
Dans toutes les lignes, les codes à 4 chiffres à utiliser sont précédées de ":".

Résultat souhaité :

A .................................B ........................................................................... C
Fruit ............... Banane - L:9900 LE5:9907 10cl:9920 ...................................... 9900
Fruit ............... Banane - L:9900 LE5:9907 10cl:9920 ...................................... 9907
Fruit ............... Banane - L:9900 LE5:9907 10cl:9920 ...................................... 9920
Légumes ....... Courgette - 30cl:3043 L:4356 .................................................. 3043
Légumes ....... Courgette - 30cl:3043 L:4356 .................................................. 4356
Conserve ....... Sardine - L:8760 L:7883 30cl:1289 40cl:9912 40cl:9913 ............. 8760
Conserve ....... Sardine - L:8760 L:7883 30cl:1289 40cl:9912 40cl:9913 ............. 7883
Conserve ....... Sardine - L:8760 L:7883 30cl:1289 40cl:9912 40cl:9913 ............. 1289
Conserve ....... Sardine - L:8760 L:7883 30cl:1289 40cl:9912 40cl:9913 ............. 9912
Conserve ....... Sardine - L:8760 L:7883 30cl:1289 40cl:9912 40cl:9913 ............. 9913


Pensez-vous que celà est possible ?

Merci de votre aide.
PS. Je n'ai pas réussi à faire des espaces pour simuler les collones, j'ai donc mis des ".". Désolé
 

Pièces jointes

Re : VBA Excel - Copier des lignes si condition

Bonjour Jacktbio et bienvenu, Pierrejean, bonjour le forum,

PierreJean a déjà œuvré mais tant pis je te propose quand même le code ci-dessous :
Code:
Sub Macro1()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim i As Integer 'déclare la variable i (Incrément de ligne)
Dim x As Integer 'déclare la variable x (Incrément de nobre de :)
 
dl = Sheets("Feuil1").Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne
 
For i = dl To 4 Step -1 'boucle 1 : inversée de la dernière ligne à la ligne 4
    If UBound(Split(Cells(i, 2).Value, ":", -1)) > 0 Then 'condition 1 : si la cellule contient au moins une fois les deux points ":"
        Cells(i, 3).Value = Mid(Split(Cells(i, 2).Value, ":", -1)(1), 1, 4) 'récupère en colonne C les 4 premiers caractères après le premier deux point ":"
    End If 'fin de la condition 1
    If UBound(Split(Cells(i, 2).Value, ":", -1)) > 1 Then 'condition 2 : si la cellule contient plusieurs une fois les deux points ":"
        For x = 1 To UBound(Split(Cells(i, 2).Value, ":", -1)) - 1 'boucle 2 : de 1 au nombre de deux points ":" contenus dans la cellule moins 1
            Rows(i).Copy 'copie la ligne i
            Rows(i + x).Insert Shift:=xlDown 'colle la ligne i en dessous en décalant de x lignes
            Cells(i + x, 3).Value = Mid(Split(Cells(i, 2).Value, ":", -1)(x + 1), 1, 4) 'récupère en colonne C les 4 premiers caractères après le xième deux point ":"
        Next x 'prochaine occurrence de deux point ":" de la boucle 2
    End If 'fin de la condition
Next i 'prochaine ligne de la boucle inversée 1
 
Application.CutCopyMode = False 'supprime le clignotement des celules lié a un "copié"
End Sub
 
Re : VBA Excel - Copier des lignes si condition

Bonjour et un très grand merci à vous deux pour avoir répondu si rapidement à mon problème. C'est exactement ce que je cherchais. Je suis vraiment impressionné par la qualité et la rapidité de vos réponse, Je vous remercie mille fois. De plus, Robert, tes explications pour chaque ligne de code sont vraiment précieuses. Merci encore 😎
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.
Retour