XL 2016 Nom d'un fichier d'une cellule copiée d'un autre classeur

[RomainPOIRET]

Bonjour à tous,

Voici le contexte :

Je copie le contenu d'une cellule "A1" du classeur "B" que je colle dans un classeur "A", en cellule "A1",
Je souhaiterai avoir le nom du fichier du classeur "B" (dont le contenu de la cellule a été copié) dans la cellule "A2" de mon classeur "A"
Est-ce possible ?

Merci d'avance pour vos réponses,

Romain

 

[job75]

Bonjour RomainPOIRET, bienvenue sur XLD,

Et bravo pour ce 1er message, la question est intéressante.

Collez cette macro dans le code de la feuille du classeur "A" (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Change(ByVal Target As Range)
With Application
    If Intersect(Target, [A1]) Is Nothing Or .CutCopyMode = 0 Then Exit Sub
    .ScreenUpdating = False
    .EnableEvents = False
    On Error Resume Next 'sécurité
    .Undo
    Paste Link:=True 'collage avec liaison
    [A2] = Mid([A1].Formula, 3)
    [A2] = Replace(Left([A2], InStr([A2], "]") - 1), "[", "")
    [A1] = [A1] 'supprime la formule
    .EnableEvents = True
End With
End Sub

Puis faites manuellement le copier-coller que vous indiquez.

A+

 

[RomainPOIRET]

Bonjour job75,

J'ai bien copié la macro dans ma feuille mais il ne me renseigne pas le nom du fichier de la cellule copié ...

Romain

 

[job75]

Chez moi si, vous n'avez pas dû mettre la macro au bon endroit.

 

[job75]

Vous avez disparu ? Je joins le fichier pour clore correctement ce fil.

 

[RomainPOIRET]

Bonjour job75 , désolé pour le temps d'attente,

Impeccable ça marche chez moi,
J'ai fais une mauvaise manipulation la dernière fois,

Pour clore cette discussion, serais-ce possible de voir comment cela fonctionne avec une boucle ? pour dupliquer le code sur les colonnes B, C, D ...

Merci encore pour votre implication,

Romain

 

[job75]

Bonjour Romain, le forum,

Je ne vois pas pourquoi on ferait une boucle :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Target(1) 'une seule cellule
With Application
    If Intersect(Target, Rows(1)) Is Nothing Or .CutCopyMode = 0 Then Exit Sub
    .ScreenUpdating = False
    .EnableEvents = False
    On Error Resume Next 'sécurité
    .Undo
    Paste Link:=True 'collage avec liaison
    If Selection.Count > 1 Then Application.DisplayAlerts = False: Application.Quit 'sécurité
    Target(2) = Mid(Target.Formula, 3)
    Target(2) = Replace(Left(Target(2), InStr(Target(2), "]") - 1), "[", "")
    Target = Target 'supprime la formule
    .EnableEvents = True
End With
Rows("1:2").Columns.AutoFit 'ajustement largeurs
End Sub

Bonne journée.

 

[RomainPOIRET]

Impeccable merci beaucoup !
Bonne journée
Romain

 

[RomainPOIRET]

Encore moi, désolé ...

Si je veux faire la même chose mais que quand je colle en A1, il me met l'adresse en B1 , A2 en B2 ... , avec un Target.Columns ?

Cordialement,

Romain

 

[job75]

Vous avez testé le fichier du post #7 ???

 

[RomainPOIRET]

Oui il marche en ligne mais si je veux cette configuration en colonne ?

 

[job75]

Alors voyez ce fichier (2) et la macro :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Target(1)
With Application
    If Intersect(Target, Columns(1)) Is Nothing Or .CutCopyMode = 0 Then Exit Sub
    .ScreenUpdating = False
    .EnableEvents = False
    On Error Resume Next 'sécurité
    .Undo
    Paste Link:=True 'collage avec liaison
    If Selection.Count > 1 Then Application.DisplayAlerts = False: Application.Quit 'sécurité
    Target(1, 2) = Mid(Target.Formula, 3)
    Target(1, 2) = Replace(Left(Target(1, 2), InStr(Target(1, 2), "]") - 1), "[", "")
    Target = Target 'supprime la formule
    .EnableEvents = True
End With
Columns("A:B").AutoFit 'ajustement largeur
End Sub

 

[RomainPOIRET]

Super, là je ne vous embête plus, merci beaucoup, ça m'est d'une grande aide

Merci !

Romain

 

[RomainPOIRET]

Bonjour @job75 , je souhaiterai désormais avoir l'adresse complète de la valeur de ma cellule copiée, je vous mets en pièce jointe un exemple,

D'avance merci,

Romain

 

[job75]

Bonsoir RomainPOIRET,

Il suffit d'ajouter une ligne dans la macro pour obtenir le chemin d'accès :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Target(1)
With Application
    If Intersect(Target, Columns(1)) Is Nothing Or .CutCopyMode = 0 Then Exit Sub
    .ScreenUpdating = False
    .EnableEvents = False
    On Error Resume Next 'sécurité
    Paste Link:=True 'collage avec liaison
    If Selection.Count > 1 Then Application.DisplayAlerts = False: Application.Quit 'sécurité
    Target(1, 2) = Mid(Target.Formula, 3)
    Target(1, 2) = Replace(Left(Target(1, 2), InStr(Target(1, 2), "]") - 1), "[", "")
    Target(1, 2) = Workbooks(Target(1, 2).Text).FullName 'avec le chemin d'accès
    Target = Target 'supprime la formule
    .EnableEvents = True
End With
Columns("A:B").AutoFit 'ajustement largeurs
End Sub

Edit : .Undo n'était pas nécessaire, je l'ai supprimé.

A+