RESOLU : Transmettre valeur unique

[AKRAMI]

Bonsoir forum
Bonsoir tout le monde
svp
Je sillicite vos aides svp dans ce fichier j'ai explique mon probleme dans Feuil1
Merci d'avance pour tous
Amicalement
AKRAMI

 

[Victor21]

Re : Transmettre valeur unique

Bonjour AKRAMI

Plutôt que des formules alambiquées avec des Trouve(), Stxt(), Nbcar(), Gauche(), Droite()...; essayez la fonction intégrée :
Volet Données,
Outils de données,
Convertir,
Délimité,
cocher Espace,
Suivant,
Destination : B4,
Terminer.

 

[AKRAMI]

Re : Transmettre valeur unique

Bonsoir Victor21
Merci beaucoup pour l'aide et l'explication
SVP monsieur Victor21 .. est ce que vous pouvez m'aider un peu plus .. car j'ai rien compris franchement
Accueil Insertion Mise en page Formule Donnees Revision Affichage Développeur..... dans quel onglet j'accede la premiere fois svp
Amicalement
AKRAMI

 

[AKRAMI]

Re : Transmettre valeur unique

Merci Victor21
Alors finalement j'ai compris ce que vous m'avez dites
Merci encore
C'est resolu
cordialement
AKRAMI

 

[DoubleZero]

Re : Transmettre valeur unique

Bonjour, AKRAMI, Victor21 , le Forum,

Autre solution, avec le code ci-après dans le module de l'onglet concerné.

Option Explicit
Private Sub Worksheet_Change(ByVal c As Range)
    If c.Address = "$A$1" Then
    If c.Value = "" Then
    Range(Range("b4"), Range("b4").End(xlToRight)) = ""
    Exit Sub
    Else
        Application.DisplayAlerts = 0
        Range(Range("b4"), Range("b4").End(xlToRight)) = ""
        Range("a1").TextToColumns Destination:=Range("B4"), DataType:=xlDelimited, _
               TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
               Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
               :=Array(Array(1, 1)), TrailingMinusNumbers:=True
        Application.DisplayAlerts = -1
    End If
    End If
End Sub

A bientôt

 

[AKRAMI]

Re : RESOLU : Transmettre valeur unique

Bonsoir DoubleZero
Merci beaucoup pour votre superbe code
Car en realité la methode de Victor21 je serai obligé chaque fois de repeter la meme procedure pour faire ce que je veux
Merci beaucoup pour cet excellent code
Amicalement
AKRAMI

 

[R@chid]

Re : RESOLU : Transmettre valeur unique

Bonsoir,
par formule, en B1 :

=SIERREUR(STXT($A1;TROUVE("|";SUBSTITUE(" "&$A1;" ";"|";COLONNES($B:B)));TROUVE("|";SUBSTITUE($A1&" ";" ";"|";COLONNES($B:B)))-TROUVE("|";SUBSTITUE(" "&$A1;" ";"|";COLONNES($B:B))));"")

@ tirer vers la droite


@ + +

 

[AKRAMI]

Re : RESOLU : Transmettre valeur unique

Bonsoir R@chid
Merci pour l'aide
Merci pour cette solution differente par formule
Une de vos meilleurs solutions
Merci beaucoup
Amicalement
AKRAMI

 

[Victor21]

Re : RESOLU : Transmettre valeur unique

Bonsoir, R@chid

Bonsoir,
par formule, en B1 :

=SIERREUR(STXT($A1;TROUVE("|";SUBSTITUE(" "&$A1;" ";"|";COLONNES($B:B)));TROUVE("|";SUBSTITUE($A1&" ";" ";"|";COLONNES($B:B)))-TROUVE("|";SUBSTITUE(" "&$A1;" ";"|";COLONNES($B:B))));"")

@ tirer vers la droite


@ + +

Just for fun :
Remplacer les $A1 par des supprespace($a1) permet en outre de gérer les espaces superfétatoires

 

[AKRAMI]

Re : RESOLU : Transmettre valeur unique

Merci Patrick pour tous
Cordialement
AKRAMI