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

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: 2

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

Yoyo60

XLDnaute Junior
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

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

Yoyo60

XLDnaute Junior
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

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

Yoyo60

XLDnaute Junior
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
 

Discussions similaires

Statistiques des forums

Discussions
311 734
Messages
2 082 020
Membres
101 872
dernier inscrit
Colin T