Couper le contenu d'une cellule en 60 caracteres

Bonjour,

j'ai essayé de chercher ma solution sur internet et dans le forum mais je ne trouve pas exactement ce que je souhaites faire, je m'explique:

J'ai un fichier avec plusieurs lignes, sur chaque lignes j'ai une cellule avec une grande ligne de texte.

Je souhaites couper le contenu de cette cellule en plusieurs cellules de 60 caractères et cela sur la ou les cellules de la ligne en dessous. Cela sans couper les mots de ma phrase en plein milieu, c'est à dire si mon soixantième caractère est en plein milieu d'un mot alors je coupe au début du mot.

Et tout cela en dupliquant les autres cellules sur les lignes dessous.

Je vous joint un fichier en exemple qui sera sans doute plus parlant que mes explications.

je vous remercie par avance de votre aide.

Cordialement

Bonjour,

cocher 'renvoyer à la ligne automatiquement' n'est pas suffisant ? Il faut vraiment répartir dans plusieurs cellules ?

eric

bonjour,

oui il faut vraiment repartir dans plusieurs cellules car aprés se sera exploité dans une base de données où chaque lignes du fichier Excel correspondra à une ligne d'une table de cette base.

Inspire toi de cette formule =GAUCHE(C4;TROUVE(" ";C4;50))

Cordialement

merci ça fonctionne mais pour un texte inférieur à 120 caractères.

De plus il faudrait que je copie les cellules Ax, Bx, Dx, et Ex dans les nouvelles lignes à la main, et le souci c'est que j'ai des fichiers de plus de 2000 lignes.

En fait j'aurais souhaité savoir s'il était possible de créer une macro qui fasse cela, je ne l'avais pas précisé dans mon premier post.

Parce qu'en faites les macro et moi, ça fait deux.

merci d'avance

Re,

Sub couperLignes()
    Dim lig As Long, i As Long, pos As Long
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    application.screenupdating=false
    For lig = Cells(Rows.Count, "C").End(xlUp).Row To 2 Step -1
        i = 0
        Do While Len(Cells(lig + i, "C")) > 60
            Rows(lig + i + 1).Insert Shift:=xlDown
            pos = InStrRev(Cells(lig + i, "C"), " ", 61)
            Cells(lig + i + 1, "C") = Mid(Cells(lig + i, "C"), pos)
            Cells(lig + i, "C") = Left(Cells(lig + i, "C"), pos - 1)
            i = i + 1
        Loop
    Next lig
    application.screenupdating=true
End Sub

eric

PS: 2 lignes application.screenupdating à ajouter au code du fichier

merci je vais tester je vous répondrais demain;

Bonne aprés midi.

Bonjour,

j'ai réussi à faire fonctionner cette macro et faire ce que je souhaité.

Juste avant de la lancé, ne pas oublier de supprimer les caractères "retour chariot" (chr(10)) et faire attention de ne pas avoir de chaines de caractères de plus de 60 caractères sans espace.

Merci encore.

Bonjour M.!

Je suis toute nouvelle dans ce monde de macro et programmation...

J'étais à la recherche d'une macro afin de faire quelque chose de vraiment semblable et je suis tomber sur ce forum.

Ce que vous avez proposé est exactement ce que je recherche mais à une exception près: est-il possible, lorsque la coupure du contenu est effectuer, de ne pas faire décaler le contenu des autres colonnes vis à vis ce texte?

eriiic a écrit :

Re,

Sub couperLignes()
    Dim lig As Long, i As Long, pos As Long
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    application.screenupdating=false
    For lig = Cells(Rows.Count, "C").End(xlUp).Row To 2 Step -1
        i = 0
        Do While Len(Cells(lig + i, "C")) > 60
            Rows(lig + i + 1).Insert Shift:=xlDown
            pos = InStrRev(Cells(lig + i, "C"), " ", 61)
            Cells(lig + i + 1, "C") = Mid(Cells(lig + i, "C"), pos)
            Cells(lig + i, "C") = Left(Cells(lig + i, "C"), pos - 1)
            i = i + 1
        Loop
    Next lig
    application.screenupdating=true
End Sub

eric

PS: 2 lignes application.screenupdating à ajouter au code du fichier

Re bonjour M. :p

Bon, je n'arrive plus à modifier mon message précédent...

J'ai trouvé ma réponse, par contre, est-ce possible de le faire à partir de cellules fusionnées?

eriiic a écrit :

Re,

Sub couperLignes()
    Dim lig As Long, i As Long, pos As Long
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    application.screenupdating=false
    For lig = Cells(Rows.Count, "C").End(xlUp).Row To 2 Step -1
        i = 0
        Do While Len(Cells(lig + i, "C")) > 60
            Rows(lig + i + 1).Insert Shift:=xlDown
            pos = InStrRev(Cells(lig + i, "C"), " ", 61)
            Cells(lig + i + 1, "C") = Mid(Cells(lig + i, "C"), pos)
            Cells(lig + i, "C") = Left(Cells(lig + i, "C"), pos - 1)
            i = i + 1
        Loop
    Next lig
    application.screenupdating=true
End Sub

eric

PS: 2 lignes application.screenupdating à ajouter au code du fichier

Bonjour,

c'est à dire ?

Pas d'erreur sur cellules fusionnées.

Dépose un fichier exemple avec ce que tu as et ce que tu veux obtenir.

eric