XL 2016 Exporter cellules vers autre feuille selon menu déroulant

stehrstrom

XLDnaute Nouveau
Bonjour,
Je suis encore novice sur VBA... Je cherche à exporter des colonnes d'un tableau en Feuille1 vers une nouvelle feuille. Ces colonnes s'exporteront selon ce qui est choisi dans un menu déroulant en Feuille1. J'affecterai ainsi cette macro à un bouton.

Un exemple en pièce jointe.
Merci beaucoup
 

Pièces jointes

  • Classeur2.xlsx
    12.2 KB · Affichages: 6

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Sterhstrom, bonjour le forum,

En pièce jointe ton fichier modifié. J'ai remplacé le contrôle par une simple liste de validation de données en E1 et ajouté un onglet.
Modifie E1 la macro événementielle Change ci-dessous agit automatiquement :

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

If Target.Address <> "$E$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en E1, sort de la procédure
Set OS = Worksheets("Feuil1") 'définit l'onglet source OS
TV = OS.Range("B2").CurrentRegion 'définit le tableau des valeurs TV
Set OD = Worksheets("Feuil2") 'définit l'onglet destination OD
OD.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 1) = Target.Value Then 'condition : si la donnée en colonne 1 de TV est égale à E1
        ReDim Preserve TL(1 To 4, 1 To K) 'redimensionne les tableau des lignes (4 lignes, K colonnes)
        For L = 1 To 4 'boulce 2 : sur les 4 colonnes de TL
            TL(L, K) = TV(I, L + 1) 'récupère dans la ligne N de TL la données colonne L+1 de TV (=> transposition)
        Next L 'prochaine colonne de la boucle 2
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next I 'prochaione ligne I de la boucle
'si K est supérieur à 1 renvoie dans A2 redimensionnée de l'onglet OD la tabelau TL transposé
If K > 1 Then OD.Range("A2").Resize(UBound(TL, 2), 4).Value = Application.Transpose(TL)
OD.Activate 'active l'onglet OD
End Sub

Le fichier :
 

Pièces jointes

  • Stehrstrom_ED_V01.xlsm
    18.6 KB · Affichages: 6

stehrstrom

XLDnaute Nouveau
Merci Robert pour toutes ces explications, ça permet de bien apprendre.
Mais je n'arrive pas à intégrer la macro dans mon fichier....
Pour palier à ma difficulté est ce qu'il serait possible d'effectuer l'action suivante en la pilotant par un bouton?
Mon fichier légèrement différent que le précédent. J'aimerai activer la macro par le BOUTON 5 (D2). Ce macro permettrai de copier les colonnes B4:N4 avec les lignes lorsqu'il y a "OUI" en A.

Merci encore pour la précédente aide.
 

Pièces jointes

  • Classeur4.xlsx
    597.2 KB · Affichages: 4

Robert

XLDnaute Barbatruc
Repose en paix
Re,

Le second fichier n'a absolument pas la même structure que le premier ni la même méthode que celle demandée dans ton premier post. Il n'y a rien de plus qui me gave que ça... Un demande est faite et lorsqu'on propose une solution la demande est changée. Je regarderai ton problème plus tard... Quand les nerfs me passeront... Peut-être...
 

stehrstrom

XLDnaute Nouveau
Bonjour Robert,
Sincères excuses pour vous avoir mis dans cet état. Votre première réponse m'a été d'une grande utilité pour comprendre le fonctionnement et pour mon fichier. J'ai en effet effectué qques modifications puisque je n'arrives pas à effectuer ma 1ere méthode... Je pensais que cette manip serait quasi similaire mais apparemment pas, désolé.
Dans tous les cas, je vous remercie pour votre rapide réponse d'hier, ça reste une grande aide, bien sûr !
Merci pour votre aide
 

Robert

XLDnaute Barbatruc
Repose en paix
Re,

VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("Feuil1") 'définit l'onglet source OS
TV = OS.Range("A3").CurrentRegion 'définit le tableau des valeurs TV
Set OD = Worksheets("Feuil2") 'définit l'onglet destination OD
OD.Range("A3").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données
K = 1 'initialise la variable K
For I = 3 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
    On Error Resume Next
    If TV(I, 1) = "OUI" Then 'condition : si la donnée en colonne 1 de TV est égale à E1
        If Err <> 0 Then
            Err.Clear
            GoTo suite
        End If
        On Error GoTo 0
        ReDim Preserve TL(1 To 13, 1 To K) 'redimensionne les tableau des lignes (4 lignes, K colonnes)
        For L = 1 To 13 'boulce 2 : sur les 4 colonnes de TL
            TL(L, K) = TV(I, L + 1) 'récupère dans la ligne N de TL la données colonne L+1 de TV (=> transposition)
        Next L 'prochaine colonne de la boucle 2
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
suite:
Next I 'prochaione ligne I de la boucle
'si K est supérieur à 1 renvoie dans A2 redimensionnée de l'onglet OD la tabelau TL transposé
If K > 1 Then OD.Range("A2").Resize(UBound(TL, 2), 13).Value = Application.Transpose(TL)
OD.Activate 'active l'onglet OD
End Sub
 

Discussions similaires