Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel isoler le contenu de certaines cellules de manière selective

isoler le contenu de certaines cellules de manière selective

9 réponses
Avatar
Help ME
Bonjour à tous.
Merci déjà de vos aides multiples et toutes "sauveuses" de modestes petits
scarabés comme moi :-)
J'ai le problème suivant sur un doc xls de 500 lignes...
J'ai dans certaines cellules 1, 2 & 3 infos qui ont été mises dans chaque
cellule et que je souhaite "éclater" en 2 & 3 cellules...Elles sont toutes
repérées par un code du style "LT:" et "AR:"
Explication sur données fictives :
Cellule F15 : LT: Bonjour comment vas-tu ?
AR: Bien Et toi ?
LT : Tres bien, merci

Cellule F16 : AR : Tant mieux
LT : Bonne journée
Cellule F17 : AR : Toi aussi

Et j'aimerai que cela devienne :
E15 LT F15 Bonjour comment vas-tu ?
E16 AR F16 Bien Et toi ?
E17 LT F17 Tres bien, merci
E18 AR F18 Tant mieux
E19 LT F19 Bonne Journée
E20 AR F20 Toi aussi


Quelqu'un aurait une idée la dessus ?
Merci de votre aide...car 500 cellules à la main, cela fait malllllllllll
:-(
Michel
Attention, il faut que je puisse lui paramétrer E et F (cad lui dire que LT
& AR sont a mettre en "E ou autre" et que le texte est en "F ou autre"

MERCI !!!!
Signaler un problème avec ce contenu

9 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
ru-th
Salut

as-tu essayé ?
données/convertir
étape 1 délimité
étape 2 autre :
(i e les 2 points)

--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Help ME" a écrit dans le message de news:
41a25db5$0$2840$
Bonjour à tous.
Merci déjà de vos aides multiples et toutes "sauveuses" de modestes petits
scarabés comme moi :-)
J'ai le problème suivant sur un doc xls de 500 lignes...
J'ai dans certaines cellules 1, 2 & 3 infos qui ont été mises dans chaque
cellule et que je souhaite "éclater" en 2 & 3 cellules...Elles sont toutes
repérées par un code du style "LT:" et "AR:"
Explication sur données fictives :
Cellule F15 : LT: Bonjour comment vas-tu ?
AR: Bien Et toi ?
LT : Tres bien, merci

Cellule F16 : AR : Tant mieux
LT : Bonne journée
Cellule F17 : AR : Toi aussi

Et j'aimerai que cela devienne :
E15 LT F15 Bonjour comment vas-tu ?
E16 AR F16 Bien Et toi ?
E17 LT F17 Tres bien, merci
E18 AR F18 Tant mieux
E19 LT F19 Bonne Journée
E20 AR F20 Toi aussi


Quelqu'un aurait une idée la dessus ?
Merci de votre aide...car 500 cellules à la main, cela fait malllllllllll
:-(
Michel
Attention, il faut que je puisse lui paramétrer E et F (cad lui dire que
LT
& AR sont a mettre en "E ou autre" et que le texte est en "F ou autre"

MERCI !!!!




Avatar
isabelle
bonjour mouspi,

si les phrase sont bien séparer par des retour à la ligne, tu pourrait utilisé une feuille tampons pour faire le travail
et ensuite recopier le résultat à l,endroit voulu.

Selection.TextToColumns Destination:=Range("F15"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:úlse, Tab:úlse, _
Semicolon:úlse, Comma:úlse, Space:úlse, Other:=True, OtherChar _
:=Chr(10), FieldInfo:=Array(Array(1, 1)), TrailingMinusNumbers:=True

For Each c In Range("F15:H17") 'plage à adapter
x = x + 1
Sheets("Feuil3").Range("A" & x) = Trim(c)'nom de feuille à adapter
Next
Sheets("Feuil3").Select
Range("A1:A" & x).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:úlse, Tab:úlse, _
Semicolon:úlse, Comma:úlse, Space:úlse, Other:=True, OtherChar _
:=":", FieldInfo:=Array(Array(1, 1)), TrailingMinusNumbers:=True

isabelle


Bonjour à tous.
Merci déjà de vos aides multiples et toutes "sauveuses" de modestes petits
scarabés comme moi :-)
J'ai le problème suivant sur un doc xls de 500 lignes...
J'ai dans certaines cellules 1, 2 & 3 infos qui ont été mises dans chaque
cellule et que je souhaite "éclater" en 2 & 3 cellules...Elles sont toutes
repérées par un code du style "LT:" et "AR:"
Explication sur données fictives :
Cellule F15 : LT: Bonjour comment vas-tu ?
AR: Bien Et toi ?
LT : Tres bien, merci

Cellule F16 : AR : Tant mieux
LT : Bonne journée
Cellule F17 : AR : Toi aussi

Et j'aimerai que cela devienne :
E15 LT F15 Bonjour comment vas-tu ?
E16 AR F16 Bien Et toi ?
E17 LT F17 Tres bien, merci
E18 AR F18 Tant mieux
E19 LT F19 Bonne Journée
E20 AR F20 Toi aussi

Quelqu'un aurait une idée la dessus ?
Merci de votre aide...car 500 cellules à la main, cela fait malllllllllll
:-(
Michel
Attention, il faut que je puisse lui paramétrer E et F (cad lui dire que LT
& AR sont a mettre en "E ou autre" et que le texte est en "F ou autre"

MERCI !!!!


Avatar
Help ME
Salut
Merci de ton aide.
C'est une bonne idée, mais dans mes textes j'ai aussi des ":" , donc là cela
ne marche pas.
Par contre je ne connaissais pas le truc, c'est cool
Merci à toi
Michel

"ru-th" a écrit dans le message de news:
uQyM#
Salut

as-tu essayé ?
données/convertir
étape 1 délimité
étape 2 autre :
(i e les 2 points)

--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Help ME" a écrit dans le message de news:
41a25db5$0$2840$
Bonjour à tous.
Merci déjà de vos aides multiples et toutes "sauveuses" de modestes
petits


scarabés comme moi :-)
J'ai le problème suivant sur un doc xls de 500 lignes...
J'ai dans certaines cellules 1, 2 & 3 infos qui ont été mises dans
chaque


cellule et que je souhaite "éclater" en 2 & 3 cellules...Elles sont
toutes


repérées par un code du style "LT:" et "AR:"
Explication sur données fictives :
Cellule F15 : LT: Bonjour comment vas-tu ?
AR: Bien Et toi ?
LT : Tres bien, merci

Cellule F16 : AR : Tant mieux
LT : Bonne journée
Cellule F17 : AR : Toi aussi

Et j'aimerai que cela devienne :
E15 LT F15 Bonjour comment vas-tu ?
E16 AR F16 Bien Et toi ?
E17 LT F17 Tres bien, merci
E18 AR F18 Tant mieux
E19 LT F19 Bonne Journée
E20 AR F20 Toi aussi


Quelqu'un aurait une idée la dessus ?
Merci de votre aide...car 500 cellules à la main, cela fait
malllllllllll


:-(
Michel
Attention, il faut que je puisse lui paramétrer E et F (cad lui dire que
LT
& AR sont a mettre en "E ou autre" et que le texte est en "F ou autre"

MERCI !!!!








Avatar
ru-th
autre possibilité
si dans ton texte, tu as les 2 1er caractères à garder dans une colonne et
à partir du 6ème dans une autre

=gauche(e15;2)
et
=stxt(e15;6;9^9)


--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Help ME" a écrit dans le message de news:
41a26884$0$3085$
Salut
Merci de ton aide.
C'est une bonne idée, mais dans mes textes j'ai aussi des ":" , donc là
cela
ne marche pas.
Par contre je ne connaissais pas le truc, c'est cool
Merci à toi
Michel

"ru-th" a écrit dans le message de news:
uQyM#
Salut

as-tu essayé ?
données/convertir
étape 1 délimité
étape 2 autre :
(i e les 2 points)

--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Help ME" a écrit dans le message de news:
41a25db5$0$2840$
Bonjour à tous.
Merci déjà de vos aides multiples et toutes "sauveuses" de modestes
petits


scarabés comme moi :-)
J'ai le problème suivant sur un doc xls de 500 lignes...
J'ai dans certaines cellules 1, 2 & 3 infos qui ont été mises dans
chaque


cellule et que je souhaite "éclater" en 2 & 3 cellules...Elles sont
toutes


repérées par un code du style "LT:" et "AR:"
Explication sur données fictives :
Cellule F15 : LT: Bonjour comment vas-tu ?
AR: Bien Et toi ?
LT : Tres bien, merci

Cellule F16 : AR : Tant mieux
LT : Bonne journée
Cellule F17 : AR : Toi aussi

Et j'aimerai que cela devienne :
E15 LT F15 Bonjour comment vas-tu ?
E16 AR F16 Bien Et toi ?
E17 LT F17 Tres bien, merci
E18 AR F18 Tant mieux
E19 LT F19 Bonne Journée
E20 AR F20 Toi aussi


Quelqu'un aurait une idée la dessus ?
Merci de votre aide...car 500 cellules à la main, cela fait
malllllllllll


:-(
Michel
Attention, il faut que je puisse lui paramétrer E et F (cad lui dire
que
LT
& AR sont a mettre en "E ou autre" et que le texte est en "F ou autre"

MERCI !!!!












Avatar
ru-th
tiens !
au moins toi tu as lu la question !
moi pas lu :
Cellule F15 : LT: Bonjour comment vas-tu ?
AR: Bien Et toi ?
LT : Tres bien, merci

Cellule F16 : AR : Tant mieux



bon, j'y vais en IV65536, mais j'espère que c'est nettoyé !
;-))

--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"isabelle" a écrit dans le message de news:

bonjour mouspi,

si les phrase sont bien séparer par des retour à la ligne, tu pourrait
utilisé une feuille tampons pour faire le travail
et ensuite recopier le résultat à l,endroit voulu.

Selection.TextToColumns Destination:=Range("F15"), DataType:=xlDelimited,
_
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:úlse,
Tab:úlse, _
Semicolon:úlse, Comma:úlse, Space:úlse, Other:=True,
OtherChar _
:=Chr(10), FieldInfo:=Array(Array(1, 1)),
TrailingMinusNumbers:=True

For Each c In Range("F15:H17") 'plage à adapter
x = x + 1
Sheets("Feuil3").Range("A" & x) = Trim(c)'nom de feuille à adapter
Next
Sheets("Feuil3").Select
Range("A1:A" & x).TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:úlse,
Tab:úlse, _
Semicolon:úlse, Comma:úlse, Space:úlse, Other:=True,
OtherChar _
:=":", FieldInfo:=Array(Array(1, 1)), TrailingMinusNumbers:=True

isabelle


Bonjour à tous.
Merci déjà de vos aides multiples et toutes "sauveuses" de modestes
petits
scarabés comme moi :-)
J'ai le problème suivant sur un doc xls de 500 lignes...
J'ai dans certaines cellules 1, 2 & 3 infos qui ont été mises dans chaque
cellule et que je souhaite "éclater" en 2 & 3 cellules...Elles sont
toutes
repérées par un code du style "LT:" et "AR:"
Explication sur données fictives :
Cellule F15 : LT: Bonjour comment vas-tu ?
AR: Bien Et toi ?
LT : Tres bien, merci

Cellule F16 : AR : Tant mieux
LT : Bonne journée
Cellule F17 : AR : Toi aussi

Et j'aimerai que cela devienne :
E15 LT F15 Bonjour comment vas-tu ?
E16 AR F16 Bien Et toi ?
E17 LT F17 Tres bien, merci
E18 AR F18 Tant mieux
E19 LT F19 Bonne Journée
E20 AR F20 Toi aussi

Quelqu'un aurait une idée la dessus ?
Merci de votre aide...car 500 cellules à la main, cela fait malllllllllll
:-(
Michel
Attention, il faut que je puisse lui paramétrer E et F (cad lui dire que
LT
& AR sont a mettre en "E ou autre" et que le texte est en "F ou autre"

MERCI !!!!




Avatar
isabelle
:-))))))
le dernier à avoir été engeôlé est Starwing, le 26 oct, si le ménage n'est pas fait tu sauras à qui faire les reproches
;-)

isabelle


tiens !
au moins toi tu as lu la question !
moi pas lu :
Cellule F15 : LT: Bonjour comment vas-tu ?
AR: Bien Et toi ?
LT : Tres bien, merci

Cellule F16 : AR : Tant mieux



bon, j'y vais en IV65536, mais j'espère que c'est nettoyé !
;-))

--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"isabelle" a écrit dans le message de news:

bonjour mouspi,

si les phrase sont bien séparer par des retour à la ligne, tu pourrait
utilisé une feuille tampons pour faire le travail
et ensuite recopier le résultat à l,endroit voulu.

Selection.TextToColumns Destination:=Range("F15"), DataType:=xlDelimited,
_
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:úlse,
Tab:úlse, _
Semicolon:úlse, Comma:úlse, Space:úlse, Other:=True,
OtherChar _
:=Chr(10), FieldInfo:=Array(Array(1, 1)),
TrailingMinusNumbers:=True

For Each c In Range("F15:H17") 'plage à adapter
x = x + 1
Sheets("Feuil3").Range("A" & x) = Trim(c)'nom de feuille à adapter
Next
Sheets("Feuil3").Select
Range("A1:A" & x).TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:úlse,
Tab:úlse, _
Semicolon:úlse, Comma:úlse, Space:úlse, Other:=True,
OtherChar _
:=":", FieldInfo:=Array(Array(1, 1)), TrailingMinusNumbers:=True

isabelle


Bonjour à tous.
Merci déjà de vos aides multiples et toutes "sauveuses" de modestes
petits
scarabés comme moi :-)
J'ai le problème suivant sur un doc xls de 500 lignes...
J'ai dans certaines cellules 1, 2 & 3 infos qui ont été mises dans chaque
cellule et que je souhaite "éclater" en 2 & 3 cellules...Elles sont
toutes
repérées par un code du style "LT:" et "AR:"
Explication sur données fictives :
Cellule F15 : LT: Bonjour comment vas-tu ?
AR: Bien Et toi ?
LT : Tres bien, merci

Cellule F16 : AR : Tant mieux
LT : Bonne journée
Cellule F17 : AR : Toi aussi

Et j'aimerai que cela devienne :
E15 LT F15 Bonjour comment vas-tu ?
E16 AR F16 Bien Et toi ?
E17 LT F17 Tres bien, merci
E18 AR F18 Tant mieux
E19 LT F19 Bonne Journée
E20 AR F20 Toi aussi

Quelqu'un aurait une idée la dessus ?
Merci de votre aide...car 500 cellules à la main, cela fait malllllllllll
:-(
Michel
Attention, il faut que je puisse lui paramétrer E et F (cad lui dire que
LT
& AR sont a mettre en "E ou autre" et que le texte est en "F ou autre"

MERCI !!!!






Avatar
Help ME
ouaouuuuu....Merci
Je vais tester ça et je pense que cela va marcher...néammoins au cas ou, si
certaines n'ont pas de retour à la ligne ?
Il y a un moyen pour lui dire : si tu trouves "LT:" fais ceci et si tu
trouves "AR : ", fais ceci ?

Merci à vous...et on sretrouve demain :-)
Michel
"isabelle" a écrit dans le message de news:

bonjour mouspi,

si les phrase sont bien séparer par des retour à la ligne, tu pourrait
utilisé une feuille tampons pour faire le travail

et ensuite recopier le résultat à l,endroit voulu.

Selection.TextToColumns Destination:=Range("F15"), DataType:=xlDelimited,
_

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:úlse,
Tab:úlse, _

Semicolon:úlse, Comma:úlse, Space:úlse, Other:=True,
OtherChar _

:=Chr(10), FieldInfo:=Array(Array(1, 1)),
TrailingMinusNumbers:=True


For Each c In Range("F15:H17") 'plage à adapter
x = x + 1
Sheets("Feuil3").Range("A" & x) = Trim(c)'nom de feuille à adapter
Next
Sheets("Feuil3").Select
Range("A1:A" & x).TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:úlse,
Tab:úlse, _

Semicolon:úlse, Comma:úlse, Space:úlse, Other:=True,
OtherChar _

:=":", FieldInfo:=Array(Array(1, 1)), TrailingMinusNumbers:=True

isabelle


Bonjour à tous.
Merci déjà de vos aides multiples et toutes "sauveuses" de modestes
petits


scarabés comme moi :-)
J'ai le problème suivant sur un doc xls de 500 lignes...
J'ai dans certaines cellules 1, 2 & 3 infos qui ont été mises dans
chaque


cellule et que je souhaite "éclater" en 2 & 3 cellules...Elles sont
toutes


repérées par un code du style "LT:" et "AR:"
Explication sur données fictives :
Cellule F15 : LT: Bonjour comment vas-tu ?
AR: Bien Et toi ?
LT : Tres bien, merci

Cellule F16 : AR : Tant mieux
LT : Bonne journée
Cellule F17 : AR : Toi aussi

Et j'aimerai que cela devienne :
E15 LT F15 Bonjour comment vas-tu ?
E16 AR F16 Bien Et toi ?
E17 LT F17 Tres bien, merci
E18 AR F18 Tant mieux
E19 LT F19 Bonne Journée
E20 AR F20 Toi aussi

Quelqu'un aurait une idée la dessus ?
Merci de votre aide...car 500 cellules à la main, cela fait
malllllllllll


:-(
Michel
Attention, il faut que je puisse lui paramétrer E et F (cad lui dire que
LT


& AR sont a mettre en "E ou autre" et que le texte est en "F ou autre"

MERCI !!!!




Avatar
Clément Marcotte
Bonjour,

Essaie cela (En cochant la référence à VBScript Regular Expressions
avant l'exécution)

Sub Reamenage()
'Ne pas oublier de cocher la référence
'à VBScript Regular Expressions
'avant de lancer le programme
Dim RE As Object, j As Integer, letexte1 As String
Dim adressedestination As String, adresseorigine As String
Dim letexte As String, numeroligneorigine As Long,
numerolignedestination As Long
Dim numerocolonneorigine As Byte, numerocolonnedestination As Byte
Dim derniereligne As Long, i As Long, lignerendu1 As Long
Dim separe As Variant
Set RE = New RegExp
'adresseorigine = inputbox("Indiquez l'adresse de votre première
cellule à traiter")
adresseorigine = "f15"
derniereligne = Range(adresseorigine).End(xlDown).Row
'adressedestination = InputBox("Indiquez l'adresse de la première
cellule de destination")
adressedestination = "e15"
Range(adresseorigine).Select
numeroligneorigine = ActiveCell.Row
numerocolonneorigine = ActiveCell.Column
lignerendu = numeroligneorigine
Range(adressedestination).Select
numerolignedestination = ActiveCell.Row
numerocolonnedestination = ActiveCell.Column
lignerendu1 = numerolignedestination
For i = numeroligneorigine To derniereligne Step 3
'Regrouper le contenu des 3 cellules du texte
'd'origine dans une seule chaîne
letexte = Cells(lignerendu, numerocolonneorigine) & Chr(10) _
& Cells(lignerendu + 1, numerocolonneorigine) & Chr(10) _
& Cells(lignerendu + 2, numerocolonneorigine)
'rediviser le texte en lignes
separe = Split(letexte, Chr(10))
'reprendre chaque ligne et l'analyser
For j = 0 To UBound(separe)
'Commencer par repérer les initiales en majuscules
'Hypothèse, seulement 2 cractères obligatoirement
'en majuscules pour les initiales
RE.IgnoreCase = False
RE.Global = True
RE.Pattern = "[ABCDEFGHIJKLNNOPQRSTUVWXYZ]{2}"
letexte = separe(j)
Set Matches = RE.Execute(letexte)
If Matches.Count = 1 Then
For Each Match In Matches
Cells(lignerendu1, numerocolonnedestination) = Match.Value
letexte1 = Right(letexte, Len(letexte) - Match.FirstIndex - 3)
If InStr(letexte1, ":") > 0 Then
letexte1 = Trim(Right(letexte1, Len(letexte1) - InStr(letexte1, ":")))
End If
Cells(lignerendu1, numerocolonnedestination + 1) = letexte1
Next
lignerendu1 = lignerendu1 + 1
Else
RE.Global = False
Do
Set Matches = RE.Execute(letexte)
For Each Match In Matches
Cells(lignerendu1, numerocolonnedestination) = Match.Value
If InStr(letexte1, ":") > 0 Then
letexte1 = Trim(Right(letexte1, Len(letexte1) - InStr(letexte1, ":") -
1))
End If
Cells(lignerendu1, numerocolonnedestination + 1) = letexte1
lignerendu1 = lignerendu1 + 1
Next
letexte = RE.Replace(letexte, "")
Loop Until Len(letexte) = 0
End If
Next
Next
End Sub


"Help ME" a écrit dans le message de
news:41a25db5$0$2840$
Bonjour à tous.
Merci déjà de vos aides multiples et toutes "sauveuses" de modestes
petits

scarabés comme moi :-)
J'ai le problème suivant sur un doc xls de 500 lignes...
J'ai dans certaines cellules 1, 2 & 3 infos qui ont été mises dans
chaque

cellule et que je souhaite "éclater" en 2 & 3 cellules...Elles sont
toutes

repérées par un code du style "LT:" et "AR:"
Explication sur données fictives :
Cellule F15 : LT: Bonjour comment vas-tu ?
AR: Bien Et toi ?
LT : Tres bien, merci

Cellule F16 : AR : Tant mieux
LT : Bonne journée
Cellule F17 : AR : Toi aussi

Et j'aimerai que cela devienne :
E15 LT F15 Bonjour comment vas-tu ?
E16 AR F16 Bien Et toi ?
E17 LT F17 Tres bien, merci
E18 AR F18 Tant mieux
E19 LT F19 Bonne Journée
E20 AR F20 Toi aussi


Quelqu'un aurait une idée la dessus ?
Merci de votre aide...car 500 cellules à la main, cela fait
malllllllllll

:-(
Michel
Attention, il faut que je puisse lui paramétrer E et F (cad lui dire
que LT

& AR sont a mettre en "E ou autre" et que le texte est en "F ou
autre"


MERCI !!!!




Avatar
Help Me
Hello
Merci à tous

Vous avez solvé mon problème :-)))

Je peux enfin reprendre le cours d'une activité normale

Merci encore
"Clément Marcotte" a écrit dans le message
de news: %
Bonjour,

Essaie cela (En cochant la référence à VBScript Regular Expressions
avant l'exécution)

Sub Reamenage()
'Ne pas oublier de cocher la référence
'à VBScript Regular Expressions
'avant de lancer le programme
Dim RE As Object, j As Integer, letexte1 As String
Dim adressedestination As String, adresseorigine As String
Dim letexte As String, numeroligneorigine As Long,
numerolignedestination As Long
Dim numerocolonneorigine As Byte, numerocolonnedestination As Byte
Dim derniereligne As Long, i As Long, lignerendu1 As Long
Dim separe As Variant
Set RE = New RegExp
'adresseorigine = inputbox("Indiquez l'adresse de votre première
cellule à traiter")
adresseorigine = "f15"
derniereligne = Range(adresseorigine).End(xlDown).Row
'adressedestination = InputBox("Indiquez l'adresse de la première
cellule de destination")
adressedestination = "e15"
Range(adresseorigine).Select
numeroligneorigine = ActiveCell.Row
numerocolonneorigine = ActiveCell.Column
lignerendu = numeroligneorigine
Range(adressedestination).Select
numerolignedestination = ActiveCell.Row
numerocolonnedestination = ActiveCell.Column
lignerendu1 = numerolignedestination
For i = numeroligneorigine To derniereligne Step 3
'Regrouper le contenu des 3 cellules du texte
'd'origine dans une seule chaîne
letexte = Cells(lignerendu, numerocolonneorigine) & Chr(10) _
& Cells(lignerendu + 1, numerocolonneorigine) & Chr(10) _
& Cells(lignerendu + 2, numerocolonneorigine)
'rediviser le texte en lignes
separe = Split(letexte, Chr(10))
'reprendre chaque ligne et l'analyser
For j = 0 To UBound(separe)
'Commencer par repérer les initiales en majuscules
'Hypothèse, seulement 2 cractères obligatoirement
'en majuscules pour les initiales
RE.IgnoreCase = False
RE.Global = True
RE.Pattern = "[ABCDEFGHIJKLNNOPQRSTUVWXYZ]{2}"
letexte = separe(j)
Set Matches = RE.Execute(letexte)
If Matches.Count = 1 Then
For Each Match In Matches
Cells(lignerendu1, numerocolonnedestination) = Match.Value
letexte1 = Right(letexte, Len(letexte) - Match.FirstIndex - 3)
If InStr(letexte1, ":") > 0 Then
letexte1 = Trim(Right(letexte1, Len(letexte1) - InStr(letexte1, ":")))
End If
Cells(lignerendu1, numerocolonnedestination + 1) = letexte1
Next
lignerendu1 = lignerendu1 + 1
Else
RE.Global = False
Do
Set Matches = RE.Execute(letexte)
For Each Match In Matches
Cells(lignerendu1, numerocolonnedestination) = Match.Value
If InStr(letexte1, ":") > 0 Then
letexte1 = Trim(Right(letexte1, Len(letexte1) - InStr(letexte1, ":") -
1))
End If
Cells(lignerendu1, numerocolonnedestination + 1) = letexte1
lignerendu1 = lignerendu1 + 1
Next
letexte = RE.Replace(letexte, "")
Loop Until Len(letexte) = 0
End If
Next
Next
End Sub


"Help ME" a écrit dans le message de
news:41a25db5$0$2840$
Bonjour à tous.
Merci déjà de vos aides multiples et toutes "sauveuses" de modestes
petits

scarabés comme moi :-)
J'ai le problème suivant sur un doc xls de 500 lignes...
J'ai dans certaines cellules 1, 2 & 3 infos qui ont été mises dans
chaque

cellule et que je souhaite "éclater" en 2 & 3 cellules...Elles sont
toutes

repérées par un code du style "LT:" et "AR:"
Explication sur données fictives :
Cellule F15 : LT: Bonjour comment vas-tu ?
AR: Bien Et toi ?
LT : Tres bien, merci

Cellule F16 : AR : Tant mieux
LT : Bonne journée
Cellule F17 : AR : Toi aussi

Et j'aimerai que cela devienne :
E15 LT F15 Bonjour comment vas-tu ?
E16 AR F16 Bien Et toi ?
E17 LT F17 Tres bien, merci
E18 AR F18 Tant mieux
E19 LT F19 Bonne Journée
E20 AR F20 Toi aussi


Quelqu'un aurait une idée la dessus ?
Merci de votre aide...car 500 cellules à la main, cela fait
malllllllllll

:-(
Michel
Attention, il faut que je puisse lui paramétrer E et F (cad lui dire
que LT

& AR sont a mettre en "E ou autre" et que le texte est en "F ou
autre"


MERCI !!!!