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

Seddiki_adz

XLDnaute Impliqué
Bonjour
Besoin d'un aide de extraire des donnée de feuil1 vers feuil2
Merci
 

Pièces jointes

  • Classeur TRANSFERT.xlsx
    12.4 KB · Affichages: 12

job75

XLDnaute Barbatruc
Bonjour le forum,
Si tu peut m'aider de faire le contraire si possible?
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+
 

Pièces jointes

  • sedikki(2).xlsm
    21.6 KB · Affichages: 8

Seddiki_adz

XLDnaute Impliqué
ME
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+
Merci job75 très gentil de ta part
 

Discussions similaires