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

Yoyo60 · 5 Novembre 2022

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

sylvanu · 5 Novembre 2022

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.

Yoyo60 · 5 Novembre 2022

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.

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

job75 · 5 Novembre 2022

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+

Yoyo60 · 5 Novembre 2022

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+

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

job75 · 6 Novembre 2022

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+

Yoyo60 · 6 Novembre 2022

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+

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

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

Yoyo60

XLDnaute Junior

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

Yoyo60

XLDnaute Junior

job75

XLDnaute Barbatruc

Pièces jointes

Yoyo60

XLDnaute Junior

job75

XLDnaute Barbatruc

Pièces jointes

Yoyo60

XLDnaute Junior

Discussions similaires