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

[RESOLU] Dupliquer X fois des lignes sur une autre feuille selon conditions

Ceciloo

XLDnaute Nouveau
Bonjour,
J'aurais besoin de votre aide pour construire une macro Excel (version mac2011 si cela est important).

Sur ma Feuille 1 j'ai 8 colonnes que je remplis au fur et à mesure.
J'aimerais que la macro parte en regardant la 2ème ligne de Feuille 1 (et ensuite traite les lignes les unes après les autres en descendant):
- d'abord les actions suivantes ne doivent avoir lieu que si "ok" apparait dans la 8ème colonne (H),
- ensuite si "oui" apparait en 6ème colonne (F) j'aimerais que les cases A à F de la ligne en question soient copiées en Feuille 2 (en partant de la 2ème ligne également pour laisser les intitulés de colonnes sur la 1ère ligne)
- ensuite j'aimerais que les cases A à E de cette ligne soit copiées X fois en Feuille 2, X étant le nombre dans la colonne G (7ème colonne)
Et ensuite ligne 3, puis 4, etc...

Pour l'instant en m'inspirant de macros trouvées ça et là j'arrive juste à dupliquer mes lignes quand ok est là, ms ensuite pour la copie multiple je coince.

Sub Help()

Dim Ligne As Long
Application.ScreenUpdating = False
lg = 1
Ligne = Sheets("Feuil1").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row + 1
For n = 1 To Ligne
If Sheets("Feuil1").Range("H" & n) = "ok" Then
Sheets("Feuil1").Select
Range("A" & n & ":" & "F" & n).Select
Selection.Copy
lg = lg + 1
Sheets("Feuil2").Select
Range("A" & lg).Select
ActiveSheet.Paste
End If
Next n
Application.ScreenUpdating = True
End Sub

Merci de l'aide que vous pourrez m'apporter!
 

Hieu

XLDnaute Impliqué
Salut,

Voilà une idée :
VB:
Sub Help()
Dim Ligne As Integer
Application.ScreenUpdating = False

lg = 1
Ligne = Sheets("Feuil1").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row + 1
For n = 1 To Ligne
    If Sheets("Feuil1").Range("H" & n) = "ok" Then
        For i = 1 To Sheets("Feuil1").Range("g" & n)
        Sheets("Feuil1").Select
        Range("A" & n & ":" & "F" & n).Copy
        lg = lg + 1
        Sheets("Feuil2").Range("A" & lg).PasteSpecial
        Next i
    End If
Next n
Application.CutCopyMode = False
End Sub

Tu n'étais pas loin, te suffisait d'intégrer une boucle dans la copie.

Pense à modifier ton intitulé de poste en "[RESOLU] Titre"
 

Ceciloo

XLDnaute Nouveau
Merci! C'est parfait! J'ai juste rajouté une condition pour le "oui" en F, mais vous m'avez réglé le problème du coller multiple et boucle bouclée!

Pour info voici donc ma macro finale:
Sub Help()
Dim Ligne As Integer
Application.ScreenUpdating = False

lg = 1
Ligne = Sheets("Feuil1").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row + 1
For n = 1 To Ligne
If Sheets("Feuil1").Range("H" & n) = "ok" Then

If Sheets("Feuil1").Range("F" & n) = "oui" Then
Sheets("Feuil1").Select
Range("A" & n & ":" & "F" & n).Select
Selection.Copy
lg = lg + 1
Sheets("Feuil2").Select
Range("A" & lg).Select
ActiveSheet.Paste
End If

For i = 1 To Sheets("Feuil1").Range("g" & n)
Sheets("Feuil1").Select
Range("A" & n & ":" & "E" & n).Copy
lg = lg + 1
Sheets("Feuil2").Range("A" & lg).PasteSpecial
Next i
End If
Next n
Application.CutCopyMode = False
End Sub
 

Discussions similaires

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