Besoin d'un coup de main pour une macro :)

[Pino12]

Bonjour à tous,

Je souhaite appliquer une macro à un tableau afin d'extraire des données hebdomadaires. Ainsi pour une semaine S23 ma macro récupérerait des données d'un fichier "Jeunesse S23.xlsx", pour la semaine semaine S24 de "Jeunesse S24.xlsx" etc..
Pour le moment j'arrive à faire marcher cette macro mais seulement pour une semaine donnée. Par exemple pour S23 j'applique :

Sub Ventes_et_stocks_test()

' Test Macro Ventes et Stocks

Range("E7").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-4],'[Jeunesse S23.xlsx]Ventes et Stocks Magasins'!R4C1:R20000C22,21,FALSE)"
Range("E7").Select
Selection.AutoFill Destination:=Range("E7:E102"), Type:=xlFillDefault

Range("F7").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-5],'[Jeunesse S23.xlsx]Ventes et Stocks Magasins'!R4C1:R20000C22,22,FALSE)"
Range("F7").Select
Selection.AutoFill Destination:=Range("F7:F102"), Type:=xlFillDefault

End Sub

J'aimerai pouvoir effectuer cette commande en remplissant toute les semaines d'un coup mais c'est un vrai casse-tête Quelqu'un aurait-il une idée de comment s'y prendre ?

En PJ vous trouverez le fichier supposé recevoir les données extraites Merci d'avance !

 

[camarchepas]

Re : Besoin d'un coup de main pour une macro

Bonjour ,

Pour pouvoir faire les tests , il nous faudrait un fichier données extraites , maquillé bien sur pour supprimer toutes données confidentielles.

Ensuite pourquoi la macro n'est pas présente dans le fichier Exemple ? il devrait être en extension .xlsm ?

En tout cas surement 2 raisons pour lesquelles il n'y a pas de réponse à ton sujet

 

[job75]

Re : Besoin d'un coup de main pour une macro

Bonjour Pino12, salut camarchepas,

La macro du post #1 peut s'écrire plus simplement :

Sub Ventes_et_stocks_test1()
Application.DisplayAlerts = False 'si des fichiers n'existent pas
[E7].Resize(96).FormulaR1C1 = _
"=VLOOKUP(RC2,'[Jeunesse S23.xlsx]Ventes et Stocks Magasins'!R4C1:R20000C22,21,0)"
[F7].Resize(96).FormulaR1C1 = _
"=VLOOKUP(RC2,'[Jeunesse S23.xlsx]Ventes et Stocks Magasins'!R4C1:R20000C22,22,0)"
End Sub

Et pour traiter toutes les colonnes "Vtes" et "Stk" :

Sub Ventes_et_stocks_test()
Dim f$, h&, c As Range, fich$
f = "Ventes et Stocks Magasins"
h = Application.Match("TOTAL", [C:C], 0) - 7 'la hauteur du tableau peut varier
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si des fichiers n'existent pas
For Each c In Range("E6", Cells(6, Columns.Count).End(xlToLeft))
  If c = "Vtes" Then
    fich = "Jeunesse S" & Val(Replace(c(0, 0), "Semaine", "")) & ".xlsx"
    c(2).Resize(h) = "=VLOOKUP(RC2,'[" & fich & "]" & f & "'!R4C1:R20000C22,21,0)"
    c(2, 2).Resize(h) = "=VLOOKUP(RC2,'[" & fich & "]" & f & "'!R4C1:R20000C22,22,0)"
  End If
Next
End Sub

A+

 

[Pino12]

Re : Besoin d'un coup de main pour une macro

Bonjour à tout les deux, merci de prendre le temps m'aider !

Job72 : Ta deuxième macro marche super bien, c'est exactement ce que je cherchais Seulement ses recherchesV ont pour premier critère $B7 à $B102 alors qu'il me faudrait de $A7 à $A102..
Aussi si tu avais un peu de temps pour m'expliquer comment elle marche ça serait super, en tant que novice VBA je n'arrive pas à la modifier ou à comprendre sa logique

Camarchepas : Je t'ai mis en PJ un des fichiers à partir desquels je dois extraire mes données, ici celui de la semaine 23. Mon objectif est de rapatrier les ventes et les stocks répertoriés sur le premier onglet tout à droite du tableau, jusqu'à mon fichier de synthèse (en PJ sur le post 1).
En ce qui concerne l'absence de la macro sur mon fichier Exemple, je ne sais pas encore comment attacher une macro à un fichier... J'enregistre tout sur le personnal.xslb ou je copie sur un word pour l'instant

Bien cordialement,

 

[job75]

Re : Besoin d'un coup de main pour une macro

Seulement ses recherchesV ont pour premier critère $B7 à $B102 alors qu'il me faudrait de $A7 à $A102..

Dans le fichier du post #1 les "Codes" sont bien en colonne B non ?

Maintenant si vous voulez la colonne A remplacez RC2 par RC1 dans les 2 formules.

Pour les explications, qu'est-ce que vous ne comprenez-pas ?

Si vous dites que c'est tout je sors.

A+

 

[Pino12]

Re : Besoin d'un coup de main pour une macro

Super, ça marche parfaitement maintenant ! Les codes étaient en A en fait

C'est surtout cette ligne qui m’échappe ! Je comprends le reste dans les grandes lignes
h = Application.Match("TOTAL", [C:C], 0) - 7 'la hauteur du tableau peut varier

Encore merci, a+ !

 

[job75]

Re : Besoin d'un coup de main pour une macro

C'est surtout cette ligne qui m’échappe ! Je comprends le reste dans les grandes lignes
h = Application.Match("TOTAL", [C:C], 0) - 7 'la hauteur du tableau peut varier

Application.Match c'est la fonction EQUIV.

Elle renvoie le n° de la ligne où se trouve (en colonne C) le mot "TOTAL" soit 103 (fichier du post #1).

En soustrayant 7 on obtient la hauteur du tableau lignes 7 à 102 soit 96.

A+

 

[Pino12]

Re : Besoin d'un coup de main pour une macro

Ok je crois que j'ai compris, encore merci

 

[Pino12]

Re : Besoin d'un coup de main pour une macro

Bonjour Job 75

J'aurai encore besoin de quelques éclaircissements sur ta macro, si tu as du temps pour m'aider :

J'aimerai savoir où le code va chercher les fichiers commençant par "Jeunesse S" pour alimenter mon fichier. Quand tu écris les lignes suivantes je ne sais pas si la macro cherche dans un dossier spécifique ou dans l'ensemble des fichiers :

For Each c In Range("E6", Cells(6, Columns.Count).End(xlToLeft))
If c = "Vtes" Then
fich = "Litté S" & Val(Replace(c(0, 0), "Semaine", "")) & ".xlsx"
c(2).Resize(h) = "=IFERROR(VLOOKUP(RC1,'[" & fich & "]" & f & "'!R4C1:R20000C22,21,0),0)"
c(2, 2).Resize(h) = "=IFERROR(VLOOKUP(RC1,'[" & fich & "]" & f & "'!R4C1:R20000C22,22,0),0)"

J'aimerai que le code comprenne qu'il doit chercher dans un dossier intitulé "H:\Data Sharing\Archives semaines antérieurs" mais je n'arrive pas à le rédiger correctement..
Merci d'avance pour ta réponse,

Pino

 

[job75]

Re : Besoin d'un coup de main pour une macro

Bonjour Pino12,

Votre macro du post #1 comme ma macro du post #3 supposent que les fichiers sources sont ouverts.

De ce fait il est inutile d'indiquer leur chemin d'accès.

Si les fichiers ne sont pas tous ouverts il faut préciser le chemin.

Avec votre dernier exemple écrivez :

fich = "H:\Data Sharing\Archives semaines antérieurs\Litté S" & Val(Replace(c(0, 0), "Semaine", "")) & ".xlsx"

...en évitant les fôtes d'orthographe comme sur "antérieurs"...

A+

 

[Pino12]

Re : Besoin d'un coup de main pour une macro

Bonjour Job75,

Etant encore novice en VBA je n'ai pas précisé que ma macro devrait utiliser des fichiers sources supposés fermé, mea culpa.

J'ai bien appliqué ta modification du post précédent et à présent les deux lignes contenant les LOOKUP plantent. Malgré mes tentatives de rectification je ne trouve pas de solution. Saurais-tu à quoi cela est du ?

Et merci pour la faute, elle m'avait échappé

Bien cordialement,

Pino

 

[job75]

Re : Besoin d'un coup de main pour une macro

Bonjour Pino12,

Je ne sais pas ce que vous faites mais si vous utilisez la macro du post #3 il ne peut pas y avoir de "plantage".

Voyez votre fichier ci-joint et cliquez sur le bouton.

Les formules sont bien créées, bien sûr elles renvoient #N/A puisque la source n'existe pas.

A+

 

[job75]

Re : Besoin d'un coup de main pour une macro

Re,

Ah mais non, au temps pour moi, les formules ne sont pas correctes.

Il faut écrire :

Sub Ventes_et_stocks_test()
Dim f$, h&, c As Range, fich$
f = "Ventes et Stocks Magasins"
h = Application.Match("TOTAL", [C:C], 0) - 7 'la hauteur du tableau peut varier
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si des fichiers n'existent pas
For Each c In Range("E6", Cells(6, Columns.Count).End(xlToLeft))
  If c = "Vtes" Then
    fich = "H:\Data Sharing\Archives semaines antérieurs\[Litté S" & Val(Replace(c(0, 0), "Semaine", "")) & ".xlsx]"
    c(2).Resize(h) = "=VLOOKUP(RC1,'" & fich & f & "'!R4C1:R20000C22,21,0)"
    c(2, 2).Resize(h) = "=VLOOKUP(RC1,'" & fich & f & "'!R4C1:R20000C22,22,0)"
  End If
Next
End Sub

Fichier (2).

A+

 

[Pino12]

Re : Besoin d'un coup de main pour une macro

Il m'affiche aussi des #N/A alors que j'ai renseigné le bon nom de fichier source.. L'erreur doit venir de ma source.

Merci encore,

Pino

 

[Pino12]

Re : Besoin d'un coup de main pour une macro

Bonjour,

Grâce à vos indications j'ai pu monter une macro bien utile pour mes collègues. Un dernier détail coince : la macro bug à la ligne en rouge (voir en bas), sans raison apparente..
Auriez-vous une idée de ce qui ne va pas ?

Sub Littérature()


' Littérature Macro

'Afficher_le_titre_la_collection_l'_auteur_en_fonction_du_Gencod APRES MODIF FICHIER FNAC

'Définition des Variables
Dim x$, y$
x = "Ventes et Stocks Magasins"
y = "H:\DC_01\FNAC Data Sharing\Semaines étudiées\[Litté S30.xlsx]"

'Rech V dans S30
Range("G1").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(R1C14, '" & y & x & "'!R4C10:R20000C14,2,0)"
Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(R1C14, '" & y & x & "'!R4C10:R20000C14,3,0)"
Range("G3").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(R1C14, '" & y & x & "'!R4C10:R20000C114,4,0)"

'***********************************************************************************************************


'Sub Ventes_et_stocks_test()

Dim f$, h&, c As Range, fich$
f = "Ventes et Stocks Magasins"
h = Application.Match("TOTAL", [C:C], 0) - 7 'la hauteur du tableau peut varier
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si des fichiers n'existent pas
For Each c In Range("E6", Cells(6, Columns.Count).End(xlToLeft))
If c = "Vtes" Then
fich = "H:\DC_01\FNAC Data Sharing\Semaines étudiées\[Litté S" & Val(Replace(c(0, 0), "Semaine", "")) & ".xlsx]"
c(2).Resize(h) = "=IFERROR(VLOOKUP(RC1,'" & fich & f & "'!R4C1:R20000C22,21,0),0)"
c(2, 2).Resize(h) = "=IFERROR(VLOOKUP(RC1,'" & fich & f & "'!R4C1:R20000C22,22,0),0)"
End If
Next

End Sub


Encore merci pour votre aide,

Pino12