XL 2016 Extraire des donnée d'une feuil vers une autre

Seddiki_adz à dit:

Si tu peut m'aider de faire le contraire si possible?

Cliquez pour agrandir...

Private Sub Worksheet_Activate()
Worksheet_Change [O1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim choix As Range, lig&, P As Range, nlig&
Set choix = [O1] 'à adapter
lig = Val(CStr(choix))
Set P = [Tableau1] 'nom du tableau structuré à adapter
nlig = P.Columns.Count - 1
Application.EnableEvents = False 'désactive les évènements
With [J2].Resize(nlig) 'J2 1ère cellule de restitution, à adapter
    If lig < 1 Then
        .Value = ""
    Else
        Set P = P(lig, 2).Resize(, nlig)
        If Intersect(Target, choix) Is Nothing Then P = Application.Transpose(.Cells) Else .Value = Application.Transpose(P)
    End If
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

job75 à dit:

Bonjour le forum,

C'est tout à fait possible avec du VBA.

Voyez ce fichier (2) et ces 2 macros dans le code de Feuil2 :

VB:

Private Sub Worksheet_Activate()
Worksheet_Change [O1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim choix As Range, lig&, P As Range, nlig&
Set choix = [O1] 'à adapter
lig = Val(CStr(choix))
Set P = [Tableau1] 'nom du tableau structuré à adapter
nlig = P.Columns.Count - 1
Application.EnableEvents = False 'désactive les évènements
With [J2].Resize(nlig) 'J2 1ère cellule de restitution, à adapter
    If lig < 1 Then
        .Value = ""
    Else
        Set P = P(lig, 2).Resize(, nlig)
        If Intersect(Target, choix) Is Nothing Then P = Application.Transpose(.Cells) Else .Value = Application.Transpose(P)
    End If
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

A+

Cliquez pour agrandir...