(PRESQUE RESOLU) Rassemblement de données VBA

Microbe

XLDnaute Junior
Bonjour à tous et toutes,
Voici mon soucis, je gère les commandes de plusieurs magasins, auprès de plusieurs fournisseurs.
J'avais un ancien fichier qui fonctionnais très bien mais au fur et a mesure, d'autres fonctions sont nécessaire.

Voici ce que je n'arrive pas a faire:

* Les données des tableaux repris sur les 3 premières feuilles (De Brouckère, Engien, Braine & Réserve), doivent venir ce regrouper dans le Tableau de la feuille "A CDE", et il faut que sur cette même feuille "A CDE", la derrière colonne "Magasin" sois remplie automatiquement en fonction de ou viennent les données, (si ca viens de la feuille De Brouckère, il faut que en magasin ca soit marqué De Brouckère, etc.

* Sur le tableau de la feuille "A CDE", il y a des formules de recherche V pour que les PA des différents fournisseurs apparaissent (il y a peut être une autre manière de faire)

Je vous met en Pj l'ancien fichier qui fonctionnait et le nouveau qui ne fonctionne pas.

Merci d'avance de l'aide qui pourrais m'être apportée.
 

Pièces jointes

  • ANCIEN.xlsm
    530.9 KB · Affichages: 48
  • NOUVEAU.xlsm
    187.1 KB · Affichages: 50

vgendron

XLDnaute Barbatruc
Hello

un essai avec ce code
VB:
Private Sub cmdConsolidateOrders_Click()
Dim ws As Worksheet
Dim rCell As Range
Dim xWS, tbl, tbl2, Arr()
Dim I As Long, k As Long
   
Application.ScreenUpdating = False
Set wsTable = ActiveWorkbook.Worksheets("A CDER")
Set lo = wsTable.ListObjects(1)
With lo
    If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    Set rCell = .InsertRowRange.Cells(1)
End With
   
tbl = Array("RESERVE", "BRAINE", "ENGHIEN", "DEBROUKERE") 'liste des feuilles
For Each xWS In tbl
    Set ws = ActiveWorkbook.Worksheets(xWS)
    With ws.ListObjects(1)
        .Range.AutoFilter Field:=3, Criteria1:="<>" 'on filtre sur la colonne 3
        'AJOUTER test si résultat filtre vide
        .DataBodyRange.SpecialCells(xlCellTypeVisible).Copy 'Copie du résultat du filtre
        rCell.PasteSpecial Paste:=xlPasteValues 'colle dans la dernière ligne de la table
    End With
    wsTable.ListObjects(1).ListRows.Add 'on ajoute une ligne vide en fin de tableau
    Fin = wsTable.Range("B" & Rows.Count).End(xlUp).Row 'on récupère le numéro de la ligne
    Set rCell = Range("B" & Fin) 'Select 'on reset rCell
Next xWS
   
Set rCell = Nothing
Set lo = Nothing
Set ws = Nothing: Set wsTable = Nothing
End Sub

Comme indiqué dans les commentaires, dans le cas ou le filtre ne retourne rien. ca bug..
 

Microbe

XLDnaute Junior
Heyyy, je n'ai pas eu d'alerte me signalant une réponse !
Merci l'ami je vais regarder à ca !
Pour les erreurs, je suppose que une simple "Si(erreur)" devrait faire l'affaire :D

Par contre quand je clique sur le bouton pour importer ce qui est à commander des différents magasins, j'ai une erreur de compilation : "Variable non définie" Private Sub cmdconsolidateOrders_Click()

Pourrais tu stp me dire dans le code VBA quelle est la partie qui définit les colonnes qui sont recopiées stp, cela me permettrai de pouvoir modifié le code au besoin.

Bat
 

vgendron

XLDnaute Barbatruc
Hello
les variables Nb et Fin n'étaient pas déclarées
VB:
Option Explicit

Dim wsTable As Worksheet
Dim lo As ListObject

Private Sub cmdClearTable_Click()
    Application.ScreenUpdating = False
    Set wsTable = ActiveWorkbook.Worksheets("A CDER")
    Set lo = wsTable.ListObjects(1)
    With lo
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    End With
    Set lo = Nothing: Set wsTable = Nothing
End Sub

Private Sub cmdConsolidateOrders_Click()
Dim ws As Worksheet
Dim rCell As Range
Dim xWS, tbl, tbl2, Arr()
Dim I As Long, k As Long
Dim nb, Fin As Integer
   
Application.ScreenUpdating = False
Set wsTable = ActiveWorkbook.Worksheets("A CDER")
Set lo = wsTable.ListObjects(1)
With lo
    If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    Set rCell = .InsertRowRange.Cells(1)
End With
   
tbl = Array("RESERVE", "BRAINE", "ENGHIEN", "DEBROUKERE") 'liste des feuilles
For Each xWS In tbl
    Set ws = ActiveWorkbook.Worksheets(xWS)
    With ws.ListObjects(1)
        .Range.AutoFilter Field:=3, Criteria1:="<>" 'on filtre sur la colonne 3
        'AJOUTER test si résultat filtre vide - sinon. mettre un On error
        On Error GoTo suivant
        nb = .DataBodyRange.Columns(3).SpecialCells(xlCellTypeVisible).Count
        .DataBodyRange.SpecialCells(xlCellTypeVisible).Copy 'Copie du résultat du filtre
        rCell.PasteSpecial Paste:=xlPasteValues 'colle dans la dernière ligne de la table
        rCell.Offset(0, 9).Resize(nb, 1) = xWS
        .Range.AutoFilter
    End With
    wsTable.ListObjects(1).ListRows.Add 'on ajoute une ligne vide en fin de tableau
    Fin = wsTable.Range("B" & Rows.Count).End(xlUp).Row 'on récupère le numéro de la ligne
    Set rCell = Range("B" & Fin) 'Select 'on reset rCell
suivant:
Next xWS
   
Set rCell = Nothing
Set lo = Nothing
Set ws = Nothing: Set wsTable = Nothing
End Sub
la partie copiée, c'est directement TOUTE la table filtrée.. comme elle contient 3 colonnes, ca prend les trois
Regarde les commentaires et lance le code en Pas à pas (Touche F8) tu verras ce qui est fait à chaque fois
 

Microbe

XLDnaute Junior
Milles merci, il reste un unique soucis, il faut absolument qu'il y ai des articles a commander pour chaque magasin sinon VBA bug, alors que je ne dois pas forcement commander a chaque fois pour tous les magasins, sinon tout fonctionne à merveille !

Je crois que dans l'ancien fichier il y avait une commande VBA justement qui gérait justement le fait que tous les magasins ne passaient pas forcement commande.

Aussi une question au niveau de l'onglet BD FOURNISSEUR, si de nouveaux fournisseurs sont a ajouter, un simple ajout de la colonne et vba vas faire la recherche ou il y a une autre manip a faire.

Merci d'avance
 
Dernière édition:

vgendron

XLDnaute Barbatruc
Bonjour Microbe
je reviens par la..
pour le premier point: quand un magasin ne commande rien. (c'est à dire?)
dans le dernier fichier, je ne vois pas de bug..

pour l'onglet BD Fournisseur
à priori, cet onglet est rempli à la main par toi..
"et VBA va faire la recherche ou il y a une autre autre manip à faire"....?? de quelle recherche parles tu?

dans le dernier fichier, il n'y a aucun code VBA qui fasse quoi que ce soit avec cet onglet...
 

Microbe

XLDnaute Junior
Hello, tout d’abord merci de regarder à mon soucis. Le fichier bug chez moi s’il y a un des tableaux qui reste sans données. Donc par exemple s’il y a des données dans les tableaux BRAINE et DEBROUCKERE mais pas dans les autres (ENGHIEN , RESERVE) ( lorsque j appuie sur le bouton dans la feuille A CDER pour faire apparaître tous les articles des différents magasins il y a une erreur VBA, donc il faut absolument que les tableaux de TOUS les magasins contiennent des données, ce qui n'est pas toujours le cas. Pour le reste j'ai trouver les solutions, si ce n'est que un futur magasin doit bientôt ouvrir et que je devrai surement ajouter une feuille avec un nouveau tableau et que je ne sais pas quelle partie du code VBA il faudra que je modifie pour que cette nouvelle feuille ce regroupe comme les autres dans le tableau de la feuille A CDE.

Ma façon de faire n'est peut être pas la bonne, je suis ouvert a toutes propositions.

Pour faire simple, j'ai une base de donnée articles, une base de donnée fournisseurs avec les prix comparatifs de chaque articles (je dois généralement commander ou c'est moins cher sauf en cas de rupture fournisseur la je me rabat sur le 2e moins cher etc...

Je recois toutes les semaines les commandes de chaques magasins que je vais coller dans le tableau de la feuille correspondante au bon magasin, la feuille A CDE regroupe en fait simplement les commandes des différents magasins dans un seul tableau et vas chercher les informations fournisseur via une formule RECHERCHE V.

Je n'arrive pas a vraiment avoir un fichier de commande qui sois clair et facile d'utilisation.

Si besoin de plus d'information, je reste disponible

Merci d'avance
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 069
Messages
2 085 040
Membres
102 764
dernier inscrit
nestu