Récuperer texte cellule alt entré

[VB@D]

Bonjour à tous et à toutes

Voilà mon problème

Dans la feuil1 de mon classeur J'ai des cellules dans lequelle il y a un retour a la ligne

exemple: cellule A1: Excel [Alt+entrée]Download ce qui donne visuellement
Excel
Download
Moi je voudrais avoir en feuil2 grace a un code VBA
En A1: Excel
En A2: Download

J'espere que j'ai été clair

Merci de votre aide

@+

VB@D

 

[vincent]

Bonsoir

Voilà une macro qui répond a ta demande

Option Explicit
Sub copiecolle()
Dim a As Integer
With ActiveCell
a = InStr(.Value, Chr(10))
If a <> 0 Then
Sheets(2).Cells(1, 1) = Left(.Value, a - 1)
Sheets(2).Cells(1, 2) = Right(.Value, Len(.Value) - a)
End If
End With
End Sub

Elle travaille sur la cellule selectionnée de la feuille active et renvoie le resultat en feuille 2

@+Vincent

 

[pyrof]

bonjour,


Sub toto()
tableau = Split(ActiveCell, Chr(10))
For b = 0 To UBound(tableau)
Sheets(2).Cells(1, b + 1) = tableau(b)
Next b
End Sub

voici une autre macro il n'y a pas de limite du nombre de alt retour

 

[VB@D]

Salut a tous les deux et merci de m'aider

Mais voila j'ai encore un probleme
Je souhaite que la macro marche quelque soit le nombre de alt+retour comme me le propose pyrof.
Mais je n'arrive pas a faire marcher sa macro

Merci de votre aide et de votre patience

@+

VB@D

 

[VB@D]

Lorsque je lance la macro il me met erreur de compilation Tableau attendu

J'avais oublié de précisé ;-)

merci

VB@D

 

[vincent]

Re le fil

je sais que split ne fonctionne pas sous 97 alors voila une macro sans:

Sub copiecolle()
Dim a As Integer, b As Integer, colonne As Integer
Dim rang As Long
colonne = 1
With ActiveCell
a = InStr(.Value, Chr(10))
Sheets(2).Cells(1, 1) = Left(.Value, a - 1)
If a = 0 Then Exit Sub
a = 0
Do
a = InStr(a + 1, .Value, Chr(10))
b = InStr(a + 1, .Value, Chr(10))
If b = 0 Then b = Len(.Value) + 1
colonne = colonne + 1
Sheets(2).Cells(1, colonne) = Mid(.Value, a + 1, b - a - 1)
Loop Until b = Len(.Value) + 1
End With
End Sub

@+Vincent

 

[VB@D]

Re Bonjour

Merci Vincent c'est IMPECCABLE
Merci encore

@+ sur le forum

VB@D

 

[VB@D]

Bonsoir

Désolé de vous redéranger mais la macro ne fonctionne pas si une cellule est vide et si une cellule comporte qu'une seul ligne ( pas de retour ligne ALT+ENRE)

Et oui je suis encore bloqué

Merci de votre aide

@+

VB@D

 

[vincent]

Re

j'ai pensé au probléme juste après.Il y a juste une petite modification pour regler ça.Remplace

a = InStr(.Value, Chr(10))
Sheets(2).Cells(1, 1) = Left(.Value, a - 1)
If a = 0 Then Exit Sub

par

a = InStr(.Value, Chr(10))
If a = 0 Then
Sheets(2).Cells(1, 1) = .Value
Exit Sub
end if

Le reste ne change pas

@+Vincent

 

[VB@D]

Bonjour Vincent

Encore merci de m'aider c vraiment super

Je n'ai pas le temps de tester ce matin car je vais au boulot :-(

Je test ce soir et adapte ca a mon programme

Je te tient au courant

@+

VB@D

 

[VB@D]

Salut

J'ai testé ta nouvelle ligne mais sur du texte multiligne (alt+entrée) il ne prend plus le premier mot
la cellule A1 reste vide

@+

VB@D

 

[VB@D]

C encore moi

Voici le nouveau code complet
Mais je n'y arrive pas

Sub copiecolle()
Dim a As Integer, b As Integer, colonne As Integer
Dim rang As Long
colonne = 1
With ActiveCell
a = InStr(.Value, Chr(10))
If a = 0 Then
Sheets(2).Cells(1, 1) = .Value
Exit Sub
End If
a = 0
Do
a = InStr(a + 1, .Value, Chr(10))
b = InStr(a + 1, .Value, Chr(10))
If b = 0 Then b = Len(.Value) + 1
colonne = colonne + 1
Sheets(2).Cells(1, colonne) = Mid(.Value, a + 1, b - a - 1)
Loop Until b = Len(.Value) + 1
End With
End Sub

VB@D

 

[vincent]

Re

il y a des jours comme ça où l'on ferait mieux de faire un solitaire plutôt que des macros lol !

mais la ça devrait marcher remplace

If a = 0 Then
Sheets(2).Cells(1, 1) = .Value
Exit Sub

par

If a = 0 Then
Sheets(2).Cells(1, 1) = .Value
else
sheets(2).cells(1,1)=Left(.Value,a-1)
Exit Sub

Voilà

@+Vincent

 

[VB@D]

Re vincent

Désolé, j'ai encore des probleme avec la macro

Ci-joint le fichier

@+

VB@D

 

[vincent]

Re

décidément je fais durée le plaisir (c'est pas serieux lol !!!!)

mais là c'est la bonne(j'éspère)

remplace

If a = 0 Then
Sheets(2).Cells(1, 1) = .Value
else
sheets(2).cells(1,1)=Left(.Value,a-1)
Exit Sub

par

If a = 0 Then
Sheets(2).Cells(1, 1) = .Value
Exit Sub
else
sheets(2).cells(1,1)=Left(.Value,a-1)

@+Vincent

Ps si ça ne marche toujours pas je te renvois ton fichiers (en ayant fait tous les tests possibles).