Macro qui ne fonctionne que partiellement

af291 · Juin 14, 2020, 6:51

Bonjour ,merci tout d’abord de m’acceuillir sur ce forum ,je suis débutant en VBA et j’ai tenté une macro pour remplir un fichier me donnant les besoins en cuisiniers suivant le plan de charge ,jour par jour.
Lorsque je lance la macro il n’y a qu’une partie des éléments qui sont copiés ,je ne comprend pas ou est le probléme .

voici la macro :
Sub chargementplanning()
’
'chargementplanningmacro
’
Dim i As Long
i = 2
j = 2

Sheets(« ordo »).Select
Application.ScreenUpdating = False
'exporte le 1er jour de la semaine
While Cells(i, 1) = Range(« a2 »)

'copie « code article »
Cells(i, 2).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 2).Select
ActiveSheet.Paste

Sheets(« ordo »).Select
'copie"cuisinier"
Cells(i, 3).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 3).Select
ActiveSheet.Paste
i = i + 1
j = j + 1

Wend

'exporte le 2eme jour de la semaine
Sheets(« ordo »).Select
j = 18
While Cells(i, 1) = Range(« a2 »)

'copie « code article »
Cells(i, 2).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 2).Select
ActiveSheet.Paste

Sheets(« ordo »).Select
'copie « cuisinier »
Cells(i, 3).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 3).Select
ActiveSheet.Paste
i = i + 1
j = j + 1

Wend

'exporte le 3eme jour de la semaine
Sheets(« ordo »).Select
j = 32
While Cells(i, 1) = Range(« a2 »)

'copie « code article »
Cells(i, 2).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 2).Select
ActiveSheet.Paste

Sheets(« ordo »).Select
'copie « cuisinier »
Cells(i, 3).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 3).Select
ActiveSheet.Paste
i = i + 1
j = j + 1

Wend

'exporte le 4eme jour de la semaine
Sheets(« ordo »).Select
j = 46

While Cells(i, 1) = Range(« a2 »)
'copie « code article »

Cells(i, 2).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 2).Select
ActiveSheet.Paste

Sheets(« ordo »).Select
'copie « cuisinier »
Cells(i, 3).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 3).Select
ActiveSheet.Paste

i = i + 1
j = j + 1

Wend

'exporte le 5eme jour de la semaine
Sheets(« ordo »).Select
j = 60

While Cells(i, 1) = Range(« a2 »)

'copie « code article »
Cells(i, 2).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 2).Select
ActiveSheet.Paste

Sheets(« ordo »).Select
'copie « cuisinier »
Cells(i, 3).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 3).Select
ActiveSheet.Paste
i = i + 1
j = j + 1

Wend
End Sub

cuisine .xlsm (23,3 Ko)

Merci de m’eclairer ,cela me permettra de progresser .bonne soirée à tous.

FFO · Juin 14, 2020, 7:53

Bonsoir

D un premier aperçu tu utilises des boucles identiques pour ramener les données correspondant à des jours (5 séries de jours)
Pour se faire tu utilises cette condition de boucle :

While Cells(i, 1) = Range(« a2 »)

Qui veut dire tant que la cellule de la ligne i colonne 1 (colonne A) est égale à la cellule A2 (Range (« a2 »)
Puis les lignes de code de recopie avec i qui démarre à 2 (i=2) et qui s incrémente de 1 à chaque tour de boucle (i=i+1)
Lorsque i atteint la valeur 15 la donnée de la cellule change de 14/04/2020 passe à 15/04/2020 donc n est plus égale à celle de la cellule A2 la ligne de code
While Cells(i, 1) = Range(« a2 ») n est plus vérifié donc la boucle s arrête et le traitement passe à la deuxième boucle correspondant au deuxième jour à traiter

Dans cette deuxième boucle bizarrement la ligne de code pour la condition est la même :
While Cells(i, 1) = Range(« a2 »)
Si cette ligne n est plus vérifié dans la première boucle elle le sera pas plus dans celle là et idem pour les suivantes
C est là que réside le PB
Il faut trouver une solution pour réactualiser la condition de boucle
Je te propose de utiliser une variable réactualisée au départ de chaque boucle en lui donnant la bonne valeur à prendre en compte
Donnée = Cells (i,1)
i est la position de la première ligne de la boucle et 1 la colonne À
Au début première boucle i=2
Donc Cells (i,1) est équivalent à range A2
Donc tu mets pour la première boucle :

Donnée = Cells (i,1)
While Cells(i, 1) = Donnée
Et le reste du code
Ce qui donne pour toute la première boucle :

Dim i As Long
i = 2
j = 2

Sheets(« ordo »).Select
Application.ScreenUpdating = False
'exporte le 1er jour de la semaine
Donnée = Cells (i,1)
While Cells(i, 1) = Donnée
'copie « code article »
Cells(i, 2).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 2).Select
ActiveSheet.Paste

Sheets(« ordo »).Select
'copie"cuisinier"
Cells(i, 3).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 3).Select
ActiveSheet.Paste
i = i + 1
j = j + 1

Wend

Idem pour les boucles suivantes
i à la valeur de la dernière boucle précédente soit 15 correspondant en colonne 1 (colonne A) a la donnée 15/04/2020 le deuxième jour à traiter ce qui donne ce code pour la deuxième boucle :

'exporte le 2eme jour de la semaine
Sheets(« ordo »).Select
j = 18
Donnée = Cells (i,1)
While Cells(i, 1) = Donnée
'copie « code article »
Cells(i, 2).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 2).Select
ActiveSheet.Paste

Sheets(« ordo »).Select
'copie « cuisinier »
Cells(i, 3).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(« planning »).Select
Cells(j, 3).Select
ActiveSheet.Paste
i = i + 1
j = j + 1

Wend

Faire à l identique pour les 3 autres boucles inséres ces mêmes lignes au même endroit :
Donnée = Cells (i,1)
While Cells(i, 1) = Donnée

Corriges et fais des essais
Fais moi un retour

Mimimathy · Juin 15, 2020, 4:53

Bonjour,
A tester .
cuisine .xlsm (30,8 Ko)

  Dim i%, j%, jour%, Dl%
  Dim Ws As Worksheet, Wd As Worksheet
  Set Ws = Sheets("ordo")
  Set Wd = Sheets("planning")
  Dl = Ws.Range("A" & Rows.Count).End(xlUp).Row
  j = 1
  Wd.Range("A1:C65000") = ""
  Application.ScreenUpdating = False
    For jour = 2 To 6
      Ws.Range("A1:C1").Copy Wd.Cells(j, 1)
      For i = 2 To Dl
        If Application.WorksheetFunction.Weekday(Ws.Cells(i, 1), 1) = jour Then
          j = j + 1
          Wd.Cells(j, 1) = Format(Application.WorksheetFunction.Weekday(Ws.Cells(i, 1), 1), "dddd")
          Wd.Cells(j, 2) = Ws.Cells(i, 2)
          Wd.Cells(j, 3) = Ws.Cells(i, 3)
        End If
      Next i
    Next jour
End Sub

af291 · Juin 15, 2020, 7:06

Bonjour ,je viens de tester ton code Mimimathy ,c’est tout a fait ce que je voulais obtenir ,même si en tant que débutant je ne comprend pas tout a fait le procédé .Si tu as quelques instant pour me détailler le cheminement je suis preneur.
Encore merci .
Cordialement ,
Franck .

Mimimathy · Juin 15, 2020, 7:24

Re,

Macro avec explications

Sub chargementplanning()
  'Déclaration des variables
  Dim i%, j%, jour%, Dl%
  Dim Ws As Worksheet, Wd As Worksheet
  
  'Attribution des variables
  Set Ws = Sheets("ordo")
  Set Wd = Sheets("planning")
  Dl = Ws.Range("A" & Rows.Count).End(xlUp).Row 'Dernière ligne remplit Sheets("ordo")
  j = 1
  Wd.Range("A1:C65000") = "" 'vidage Sheets("planning")
  Application.ScreenUpdating = False 'Désactivation rafraichissement écran
  
    'Boucle sur les jours de la semaine (2=Lundi - 6= Vendredi)
    For jour = 2 To 6
      'Je copie sur la Sheets("planning") la première ligne de la Sheets("ordo")
      Ws.Range("A1:C1").Copy Wd.Cells(j, 1)
      'Boucle sur la Sheets("ordo") de la ligne 2 à la dernière remplit
      For i = 2 To Dl
        'Si le JourSem de la ligne i, colonne 1 (A) est égale à la variable jour, alors
        If Application.WorksheetFunction.Weekday(Ws.Cells(i, 1), 1) = jour Then
          'J'ajoute une ligne
          j = j + 1
          'je copie dans la Sheets("planning") les valeurs  de la Sheets("ordo"), colonne par colonne
          Wd.Cells(j, 1) = Format(Application.WorksheetFunction.Weekday(Ws.Cells(i, 1), 1), "dddd")
          Wd.Cells(j, 2) = Ws.Cells(i, 2)
          Wd.Cells(j, 3) = Ws.Cells(i, 3)
        End If
      Next i
    Next jour
    'la suppression des valeurs en double du nom de jour est modifié par une mise en forme conditionnelle,
    'ainsi que le quadrillage
End Sub

af291 · Juin 15, 2020, 7:24

Bonjour FFO,j’ai testé ce qu’a proposer Mimimathy et cela fonctionne parfaitement ,sauf quand je souhaite commencer la semaine le lundi ,j’ai un message d’erreur :"Erreur d’execution ,impossible de lire la propriété weekday de la classe worksheetfunction "
Je pensais a changer =For Jour =2 to 6 en For Jour =1to 5 mais ca ne fonctionne pas .
On va y arriver …
Merci,
Franck .

af291 · Juin 15, 2020, 7:27

Re bonjour ,
le teste est concluant lorsque je commence ma semaine le mardi mais si j’entre un planning débutant le lundi j’ai un message d’erreur :"Erreur d’exécution ,impossible de lire la propriété weekday de la classe worksheetfunction "
Je pensais a changer =For Jour =2 to 6 en For Jour =1to 5 mais ça ne fonctionne pas .
Si tu as une piste ,je pense que je vais en apprendre beaucoup sur ce forum !!
Merci ,
Franck .

Mimimathy · Juin 15, 2020, 7:32

Re,
Juste une inversion de la ligne d’ajout de ligne
cuisine .xlsm (29,9 Ko)

af291 · Juin 15, 2020, 7:53

Merci , et si je souhaite avoir la somme des cuisiniers jour par jour sachant que le nombre de recette peut varier chaque semaine ,je ne peux pas placer une cellule avec les sommes ,je suis un juste en connaissance excel sur ce coup là …
Merci de votre aide .
Franck.

Mimimathy · Juin 15, 2020, 8:04

Re,
cuisine .xlsm (30,3 Ko)

af291 · Juin 15, 2020, 7:58

Merci a tous pour votre aide precieuse ,les explications sont bienvenues et très interssantes .
Merci Mimimathy et FFO.
Franck .

system · Juillet 15, 2020, 7:58

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.