Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 copiage de données par VBA

MedAliS

XLDnaute Nouveau
Bonjour à toute la communité je voudrais quelqu’un pour m’aider à la réalisation d’un code VBA qui pourrai exécuter les tâches suivantes :

  • Copier le texte de la ligne B de la feuil1 vers la ligne A de la feuil2 et on lui ajoutant l’indice F suivie de 1 à n cette indice se trouve dans la ligne F de la feuil1 (donc répété l’action pour n ligne de la feuil2).

  • Copier le texte de la ligne D et E pour chaque copiage (Voir l’exemple ci-joint pour expliquer mieux ma demande)
Exemple :

Voir image Feuil1





Voir image Feuil2 :

  • Le contenu de la cellule B2 a était répété 4 fois dans des ligne successif en lui rajoutant l’indice F1 à F4 (nombre fixé dans la cellule F2)
  • Les X et les Y ont était copier 4 fois sur des ligne successif.
(Le texte en rouge pour montrer le changement que je voudrais faire)



Sachant que le fichier peut contenir des milliers de lignes.

J’espère que c’est bien clair.

Et merci d’avance
 

Pièces jointes

  • Copie en VBA.xlsx
    20.6 KB · Affichages: 12

Softmama

XLDnaute Accro
Bonjour MedAliS,

Cette macro doit répondre à la demande :

VB:
Private Sub CommandButton1_Click()
Dim Valeurs(), cp As Long, Resultat(), lg As Long


Valeurs = Feuil1.Range("B2:F" & Feuil1.Range("B1000000").End(xlUp).Row).Value
For t = LBound(Valeurs, 1) To UBound(Valeurs, 1)
 
  For u = 1 To Valeurs(t, 5)
    lg = lg + 1
    ReDim Preserve Resultat(1 To 3, 1 To lg)
    Resultat(1, lg) = Valeurs(t, 1) & "F" & u
    Resultat(2, lg) = Valeurs(t, 3)
    Resultat(3, lg) = Valeurs(t, 4)
  Next


Next


Feuil2.Range("a2").Resize(UBound(Resultat, 2), UBound(Resultat, 1)) = Application.Transpose(Resultat)
Feuil2.Activate
End Sub

cf. fichier joint
 

Pièces jointes

  • Copie en VBA.xlsm
    31.7 KB · Affichages: 4

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…