Duplications des lignes

Bonjour a tous

je ne sais ci mon demande est possible

dans le fichier ci_joint je veux duplicer les lignes pour les personne qui ont plusieurs choix (les choix sont separe par des point virgules ) pour avoir les choix sur des ligne differents avec les meme infos pour les autres colones

mercii

Salut,

Voici un essai.

Cordialement.

merciiii Yvouille parfait

vraiment mercii mercii

Bien Cordialement

Re,

En regardant encore une fois ce matin ma macro, je me suis rendu compte que j'ai oublié d'effacé deux lignes de code que j'avais placées pour mes essais.

Tu peux donc effacer sans autre ce passage :

        Dim xx As Integer
        xx = Len(Range("C" & ActiveCell.Row + 1))

Voici la macro définitive

Sub Séparation()
Dim i As Integer

Application.ScreenUpdating = False

Range("C2").Activate

Do Until ActiveCell = ""
    On Error Resume Next
    i = WorksheetFunction.Search(";", ActiveCell)
    If i > 0 Then
        Rows(ActiveCell.Row + 1).Insert shift:=xlDown
        Range("A" & ActiveCell.Row & ":E" & ActiveCell.Row).Copy Range("A" & ActiveCell.Row + 1)
        Range("C" & ActiveCell.Row) = Left(Range("C" & ActiveCell.Row), i - 1)
        Range("C" & ActiveCell.Row + 1) = Right(Range("C" & ActiveCell.Row + 1), Len(Range("C" & ActiveCell.Row + 1)) - i)
    End If

    ActiveCell.Offset(1, 0).Activate
    i = 0
Loop

End Sub

Amicalement.

Merci , par contre j'essaie d'adapter le macro avec mon fichier mais j'arrive pas en indiquant que dans mon fichier il y a

des colonnes jusqu'a CF

je veux continue à essayer et Si j'arrive pas je reviens vers toi

merci de nouveau

ci joint mon fichier ou je travail

et je travail sur le colone AY pour la duplication

amicalement

salut dexieme fois;

il faut juste modifier le macro que si on a une caisse vide pour qu'il le passe a l'autre

je besoins de toi *

merci beaucoup

Re,

La prochaine fois tu me fournis de suite ton fichier réel ; ça évite du boulot inutile

Dans ton nouveau fichier, tu as une cellule AY2 vide. Un tel cas est-il vraiment possible dans la réalité ?

Maintenant tu as parfois des points-virgules après la dernière référence d’une série dans une cellule de la colonne AY. De tels cas sont-ils vraiment possibles dans la réalité ?

A te relire.

NB : Si ton problème n'est pas résolu, enlève le signe indiquant qu'il l'est.

Vraiment je suis tres desole mais j'ai fais ca pour facilites le travail pour vous

tu peux s'il te plait juste me regler le code sur l'ancien exemple si on a des cellules vide et apres pour les point virgules

je peux regler ca

merci et tres desole

amicalement

Tu n'as pas répondu à mes quesitons !

Yvouille a écrit :

Dans ton nouveau fichier, tu as une cellule AY2 vide. Un tel cas est-il vraiment possible dans la réalité ?

Yvouille a écrit :

Maintenant tu as parfois des points-virgules après la dernière référence d’une série dans une cellule de la colonne AY. De tels cas sont-ils vraiment possibles dans la réalité ?

Amicalement.

* pour les cellules dans AY vides oui c'est possible dans la réalité pour cela je veux que le macros quand il voit des cellules vide il passe à celle d'apres

* pour le moment cas des points virgules est reel aussi mais ce fichier est une extract et il y a une basse de donnes derriere.

alors la je travaille pour apres ce cas (point virgule à la fin n'existeras pas )

je te remercie 1000 fois tu me sauve la vie

Re,

Dans le fichier ci-joint, la macro ci-dessous execute ces operations :

1) Contrôle de la colonne AY : si un point-virgule est placé en dernier, il est effacé.

2) Passage en revue de toutes les lignes depuis la ligne 2, tant que la colonne A ET la colonne AY ne sont pas vides.

3) Séparation de lignes comme tu le désires.

Option Explicit

Sub Séparation()
Dim i As Integer, j As Integer, DerLig As Integer

Application.ScreenUpdating = False

DerLig = Range("AY" & Rows.Count).End(xlUp).Row

For j = 2 To DerLig
    If Right(Range("AY" & j), 1) = ";" Then Range("AY" & j) = Left(Range("AY" & j), Len(Range("AY" & j)) - 1)
Next j

Range("AY2").Activate

Do Until ActiveCell = "" And Range("A" & ActiveCell.Row) = ""
    On Error Resume Next
    i = WorksheetFunction.Search(";", ActiveCell)
    If i > 0 Then
        Rows(ActiveCell.Row + 1).Insert shift:=xlDown
        Range("A" & ActiveCell.Row & ":CF" & ActiveCell.Row).Copy Range("A" & ActiveCell.Row + 1)
        Range("AY" & ActiveCell.Row) = Left(Range("AY" & ActiveCell.Row), i - 1)
        Range("AY" & ActiveCell.Row + 1) = Right(Range("AY" & ActiveCell.Row + 1), Len(Range("AY" & ActiveCell.Row + 1)) - i)
    End If

    ActiveCell.Offset(1, 0).Activate
    i = 0
Loop

End Sub

Amicalement.

parfaiiit

Merci Merci et 1000 fois merci pour le temps que tu m'as donne

Amicalement