XL 2019 Macro vba dupliquer ligne selon conditions

  • Initiateur de la discussion Initiateur de la discussion nikki
  • 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 !

nikki

XLDnaute Nouveau
Bonjour à tous,

Je souhaiterais créer une macro (je ne m'y connais quasiment pas) me permettant de dupliquer des lignes de mon tableau selon certaines conditions.
Je vous mets un exemple, ce sera largement plus parlant.
J'espère que l'un d'entre vous pourra m'aider.🙄
J'ai deux onglets me permettant de créer le 3ème qui lui sera mon tableau de résultat.
Merci à tous et bonne soirée.
 

Pièces jointes

Solution
bonjour nikki
cette macro fait ce que vous souhaitez.
un bouton dans la 1er feuille déclenche la macro
pour un test effacer la feuille résultat, déclencher la macro.
VB:
Sub ventilation()
Dim F1 As String
Dim F2 As String
Dim f3 As String
F1 = Sheets("Données").Name
F2 = Sheets("Critères").Name
f3 = Sheets("Résultat").Name
Sheets(f3).Range("A2:C20").ClearContents 'adapter la plage de cellules

Sheets(F2).Select
li_1 = Sheets(F1).Cells(36000, 1).End(xlUp).Row
li_2 = Sheets(F2).Cells(36000, 1).End(xlUp).Row
ligne = Sheets(f3).Cells(36000, 1).End(xlUp).Row + 1

For i_2 = 2 To li_2
For i_1 = 2 To li_1

  If Sheets(F2).Range("A" & i_2) = Sheets(F1).Range("A" & i_1) Then

   Sheets(f3).Cells(ligne, 1) = Sheets(F2).Cells(i_2, 2)...
bonjour nikki
cette macro fait ce que vous souhaitez.
un bouton dans la 1er feuille déclenche la macro
pour un test effacer la feuille résultat, déclencher la macro.
VB:
Sub ventilation()
Dim F1 As String
Dim F2 As String
Dim f3 As String
F1 = Sheets("Données").Name
F2 = Sheets("Critères").Name
f3 = Sheets("Résultat").Name
Sheets(f3).Range("A2:C20").ClearContents 'adapter la plage de cellules

Sheets(F2).Select
li_1 = Sheets(F1).Cells(36000, 1).End(xlUp).Row
li_2 = Sheets(F2).Cells(36000, 1).End(xlUp).Row
ligne = Sheets(f3).Cells(36000, 1).End(xlUp).Row + 1

For i_2 = 2 To li_2
For i_1 = 2 To li_1

  If Sheets(F2).Range("A" & i_2) = Sheets(F1).Range("A" & i_1) Then

   Sheets(f3).Cells(ligne, 1) = Sheets(F2).Cells(i_2, 2)
    Sheets(f3).Cells(ligne, 2) = Sheets(F1).Cells(i_1, 2)
   Sheets(f3).Cells(ligne, 3) = Sheets(F1).Cells(i_1, 3)
 
ligne = ligne + 1
End If
Next
Next
MsgBox ("modifications effectuées")
Sheets(f3).Select
Range("A1").Select

End Sub
cordialement
galougalou
 

Pièces jointes

Dernière édition:
- 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

Discussions similaires

Réponses
4
Affichages
221
Retour