Microsoft 365 Export de données suivant la valeur d'une liste via VBA

Y

Yoyo60

XLDnaute Junior
Bonjour à toutes et à tous,

Une nouvelle fois je me tourne vers vous car après avoir longuement cherché, je suis perdu.

Sans nul doute un problème simple, mais je coince pour avancer...

J'ai un fichier contenant 2 onglets.

Dans le premier onglet ('Listing'), j'ai un tableau contenant des références générées à partir des informations de ce tableau.

Dans le second onglet ('Services'), j'ai créer une liste de validation de donnée pointant sur les références de l'onglet 'Listing'.

Jusqu'ici, tout va bien.... :)

Mon souhait :

A partir de la référence que je sélectionne dans l'onglet 'Services', exporter via une macro, l'ensemble des données des différents services (nombre et total)
vers la ligne correspondante à la même référence de l'onglet 'Listing'.
Une fois ces données ajoutées au tableau, je vais les effacer de l'onglet 'Services' pour en mettre d'autres afin de compléter les autres références.

Très certainement une manipulation 'simple', mais j'ai beaucoup cherché sans trouver...

Je suis friand de votre aide et de vos bons conseils.

Merci d'avance

Yoyo

Ci-joint, un fichier d'exemple
 

Pièces jointes

  • AideExport.xlsm
    22.9 KB · Affichages: 3
Trier par date Trier par votes
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Yoyo,
Un essai en PJ avec :
VB: 
Sub Exporter()
    If Application.CountIf(Sheets("Listing").[B:B], [D6]) > 0 Then  ' La référence existe t-elle ?
        Ligne = Application.Match([D6], Sheets("Listing").[B:B], 0) ' Si oui sur quelle ligne ?
        With Sheets("Listing")
            .Cells(Ligne, "F") = [F6]
            .Cells(Ligne, "G") = [G6]
            .Cells(Ligne, "H") = [F9]
            .Cells(Ligne, "I") = [G9]
            .Cells(Ligne, "J") = [F12]
            .Cells(Ligne, "K") = [G12]
            .Cells(Ligne, "L") = [F15]
            .Cells(Ligne, "M") = [G15]
        End With
            Set Plage = Union([F6:G6], [F9:G9], [F12:G12], [F15:G15], [D6])
            Plage.ClearContents
    Else                                                            ' Sinon
        MsgBox " Cette référence n'existe pas dans le listing"      ' Alerte. Sinon on peut aussi créer cette nouvelle référence.
    End If
End Sub
Si la Ref n'existe pas on émet un message g'erreur.
Mais on pourrait aussi créer cette nouvelle ref dans le listing. A vous de voir.
 

Pièces jointes

  • AideExport.xlsm
    21.8 KB · Affichages: 5
Vote positif 0 Vote négatif
Y

Yoyo60

XLDnaute Junior
sylvanu à dit:
Bonjour Yoyo,
Un essai en PJ avec :
VB: 
Sub Exporter()
    If Application.CountIf(Sheets("Listing").[B:B], [D6]) > 0 Then  ' La référence existe t-elle ?
        Ligne = Application.Match([D6], Sheets("Listing").[B:B], 0) ' Si oui sur quelle ligne ?
        With Sheets("Listing")
            .Cells(Ligne, "F") = [F6]
            .Cells(Ligne, "G") = [G6]
            .Cells(Ligne, "H") = [F9]
            .Cells(Ligne, "I") = [G9]
            .Cells(Ligne, "J") = [F12]
            .Cells(Ligne, "K") = [G12]
            .Cells(Ligne, "L") = [F15]
            .Cells(Ligne, "M") = [G15]
        End With
            Set Plage = Union([F6:G6], [F9:G9], [F12:G12], [F15:G15], [D6])
            Plage.ClearContents
    Else                                                            ' Sinon
        MsgBox " Cette référence n'existe pas dans le listing"      ' Alerte. Sinon on peut aussi créer cette nouvelle référence.
    End If
End Sub
Si la Ref n'existe pas on émet un message g'erreur.
Mais on pourrait aussi créer cette nouvelle ref dans le listing. A vous de voir.
Cliquez pour agrandir...
Bonsoir Sylvanu,

Merci pour votre réactivité.

C'est parfait, exactement ce que je recherche.

J'essaye de comprendre les différentes étapes pour mieux comprendre.

Un grand merci à vous

Yoyo
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonsoir Yoyo60,

Une autre solution avec cette macro évènementielle dans le code de la feuille "Services" :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D6]) Is Nothing Then Exit Sub
Dim i As Variant
With Sheets("Listing").Range("B4:B" & Rows.Count)
    i = Application.Match([D6], .Cells, 0)
    If IsError(i) Then Exit Sub
    .Cells(i, 5).Resize(, 2) = [F6:G6].Value2
    .Cells(i, 7).Resize(, 2) = [F9:G9].Value2
    .Cells(i, 9).Resize(, 2) = [F12:G12].Value2
    .Cells(i, 11).Resize(, 2) = [F15:G15].Value2
End With
[F6:G6,F9:G9,F12:G12,F15:G15].ClearContents 'RAZ
MsgBox "Les données ont été transférées en feuille Listing..."
End Sub
Modifiez ou validez D6.

Les cellules devant contenir des valeurs monétaires sont au format Comptabilité.

A+
 

Pièces jointes

  • AideExport(1).xlsm
    23.1 KB · Affichages: 6
Vote positif 0 Vote négatif
Y

Yoyo60

XLDnaute Junior
job75 à dit:
Bonsoir Yoyo60,

Une autre solution avec cette macro évènementielle dans le code de la feuille "Services" :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D6]) Is Nothing Then Exit Sub
Dim i As Variant
With Sheets("Listing").Range("B4:B" & Rows.Count)
    i = Application.Match([D6], .Cells, 0)
    If IsError(i) Then Exit Sub
    .Cells(i, 5).Resize(, 2) = [F6:G6].Value2
    .Cells(i, 7).Resize(, 2) = [F9:G9].Value2
    .Cells(i, 9).Resize(, 2) = [F12:G12].Value2
    .Cells(i, 11).Resize(, 2) = [F15:G15].Value2
End With
[F6:G6,F9:G9,F12:G12,F15:G15].ClearContents 'RAZ
MsgBox "Les données ont été transférées en feuille Listing..."
End Sub
Modifiez ou validez D6.

Les cellules devant contenir des valeurs monétaires sont au format Comptabilité.

A+
Cliquez pour agrandir...
Bonsoir job75

Merci pour votre participation
J'ai regardé avec attention votre post.

Il est plus facile pour moi de comprendre sa composition afin de l'adapter à mon fichier.
Votre façon de programmer fonctionne correctement (au même titre que celle de sylvanu)
Mais je comprend mieux votre code

Cependant, je n'arrive pas à placer ce code dans une macro afin de contourner l'automatisme qui lance l'exportation directement en changeant la référence (ou en la validant).

Est-il possible d'utiliser ce code dans une macro pour pouvoir l'exécuter en cliquant sur un bouton ?
J'imagine qu'il ne faut pas que ce code soit placé directement dans la feuille mais dans un module...

D'avance merci pour votre retour

Yoyo
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Yoyo60, le forum,

Puisque l'on traite les données de la feuille "Services" il vaut mieux que le code du bouton soit dans cette feuille :
VB: 
Private Sub CommandButton1_Click()
Dim i As Variant
With Sheets("Listing").Range("B4:B" & Rows.Count)
    i = Application.Match([D6], .Cells, 0)
    If IsError(i) Then Exit Sub
    .Cells(i, 5).Resize(, 2) = [F6:G6].Value2
    .Cells(i, 7).Resize(, 2) = [F9:G9].Value2
    .Cells(i, 9).Resize(, 2) = [F12:G12].Value2
    .Cells(i, 11).Resize(, 2) = [F15:G15].Value2
End With
[F6:G6,F9:G9,F12:G12,F15:G15].ClearContents 'RAZ
MsgBox "Les données ont été transférées en feuille Listing..."
End Sub
A+
 

Pièces jointes

  • AideExport(2).xlsm
    27.7 KB · Affichages: 6
Vote positif 0 Vote négatif
Y

Yoyo60

XLDnaute Junior
job75 à dit:
Bonjour Yoyo60, le forum,

Puisque l'on traite les données de la feuille "Services" il vaut mieux que le code du bouton soit dans cette feuille :
VB: 
Private Sub CommandButton1_Click()
Dim i As Variant
With Sheets("Listing").Range("B4:B" & Rows.Count)
    i = Application.Match([D6], .Cells, 0)
    If IsError(i) Then Exit Sub
    .Cells(i, 5).Resize(, 2) = [F6:G6].Value2
    .Cells(i, 7).Resize(, 2) = [F9:G9].Value2
    .Cells(i, 9).Resize(, 2) = [F12:G12].Value2
    .Cells(i, 11).Resize(, 2) = [F15:G15].Value2
End With
[F6:G6,F9:G9,F12:G12,F15:G15].ClearContents 'RAZ
MsgBox "Les données ont été transférées en feuille Listing..."
End Sub
A+
Cliquez pour agrandir...
Bonjour job75,

Merci pour votre retour.

C'est parfait. Tout fonctionne à merveille.
J'avais trouvé une ''bidouille'' en soirée mais je préfère de loin votre méthode.

Merci pour votre participation qui me permet d'avancer et de m'améliorer (petit à petit) :)

Bon dimanche à vous
 
Vote positif 0 Vote négatif

Discussions similaires

Z
  • Résolu(e)
XL 2016 VBA EXPORT CSV
Réponses
7
Affichages
257
ZZ59264
Z
F
  • Question
XL 2021 Liste déroulante vers un autre classeur
Réponses
1
Affichages
294
Dudu2
Dudu2
T
  • Question
XL 2016 Recherche dernier utilisateur de l'item
Réponses
6
Affichages
182
tuti
T
F
  • Résolu(e)
Microsoft 365 copier coller des colonnes en fonction de la valeur d'une cellule
Réponses
8
Affichages
582
loloboc
L
Lisette
  • Question
Microsoft 365 VBA : copier / coller d'un onglet à l'autre en fonction d'une valeur
Réponses
8
Affichages
525
Lisette
Lisette
S
  • Question
XL 2019 Regroupement et report de données
Réponses
2
Affichages
344
AtTheOne
AtTheOne
G
  • Question
Microsoft 365 Export données
Réponses
4
Affichages
433
GClaire
G
B
  • Question
XL 2016 Récupérer les valeurs de chaque titre à partir de plusieurs onglets
Réponses
4
Affichages
338
bnolwalid
B
E
  • Question
XL 2016 aide tableau acompte
Réponses
5
Affichages
203
chris
chris
O
  • Question
XL 2013 Recopier automatique des valeurs d'un onglet vers un autre onglet selon critère
Réponses
2
Affichages
443
olivieroma
O

Membres actuellement en ligne

25 membres et 249 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 756
Messages
2 112 555
Membres
111 595
dernier inscrit
Natvsi