Le probleme : Erreur 1004

30classeur1.zip (444.37 Ko)
18classeur2.zip (974.89 Ko)
17classeur3.xlsx (81.22 Ko)
13classeur4.xlsx (19.65 Ko)
19classeur5.xlsx (254.11 Ko)

bonjour tout le monde , j'espere que vous allez bien.

bon je recois une erreur 1004 je ne sais pas pourquoi mon code ne marche pas.

mon code consiste a prendre chaque produit fini dans la feuille PLANIF et voir ses composants dans la feuille Nomenclatures. j ai decide de faire un filtre par le nom du produit fini car tous ses composants sont successift dans les lignes, apres pour chaque composant je vois sa disponibilité dans le magasin dans la feuille MAGASIN je calcule la quantité souhaitée de ce composant puis je verifie la date de peremption des quantites sur le magasin et la quantité qui manque je vais vois dans la feuille CA des commandes d'achat si on a deja passé une commande et on complete la quantité manquante et a la fin de chaque operation on genere un message qui nous donne la situation de chaque composant dans la colonne des msg.

ps: au début on supprime les lignes des pso (les produits semi fini ) dans la premiere feuille et les produits qui sont quasi-totallement livrés. on ajoute ensuite la taille de lot de chaque produit.

on distingue entre 2 types de composants les pso et ceux qui ne sont pas pso si on trouve le composants pso on le traite de nouveau ses composants.

vous trouverez ci-joint le code et le fichier excel. je vais vous donner feuille par feuille

 
Sub planif()

'On va ajouter colonne des msgs et colonne taille de lot
 'activation planif
 Worksheets("PLANIF").Activate   'activer la feuille planif
 'Le tri croissant par date :
Range("A1 :Q" & xlDown).Sort Key1:=Range("O1"), Order1:=xlAscending, Header:=xlYes

For i = 2 To xlDown
  Dim D As Date
  D = Cells(i, "O").Value
  Dim Msg As String
  Msg = Cells(i, "Q").Value
  Dim QL As Integer    'quantité livrée
  Dim QT As Integer   'quantité totale
  Dim TL As Integer    'taille du lot
  QL = Cells(i, "N").Value
  QT = Cells(i, "M").Value
  TL = Cells(i, "P").Value
  Dim P As String    'nom du produit
  P = Cells(i, "F").Value

  'activation taille de lot
  Worksheets("TAILLE").Activate
  t = 2
  While Cells(t, "B").Value <> P
    t = t + 1
  Wend
  LOT = Cells(t, "D").Value
  Worksheets("PLANIF").Activate
  'Activation planif
  TL = LOT  'pour ajouter la taille de lot de chaque produit
  If Left(Cells(i, "F").Value, 3) = "PSO" Or QL >= QT * 0.95 Then
           Rows(i).Delete
           L = L - 1

  'pour éliminer les pso et les produits qui sont livrés quasi-totalement

  Else
   ' Activation feuille nomenc.
   Worksheets("Nomenclatures").Activate
   J = 2
   While Cells(J, "B").Value <> P
     J = J + 1
   Wend
   'Boucle while pour savoir la ligne du premier composant
   Nomenclature.Range("A1:N1").AutoFilter field:=2, Criteria1:=P
   'Filtre par nom du produit
   'Traitement avec j jusqu'à xlDown
   For u = J To xlDown
     Dim N As String
     N = Cells(u, "H").Value 'composant
     Dim Q As Integer
     Q = Cells(u, "i").Value * (QT / TL) 'quantité du composant dans la QT
     If Left(N, 3) <> "pso" Then
       'activer magasin
       Worksheets("MAGASIN").Activate
       For y = 2 To xlDown
          If Cells(y, "B").Value = N Then

             If Cells(y, "P").Value <= D Then ' date peremption
                    'activation CA
                    Worksheets("CA").Activate
                    Z = 2
                    Do While Z <= xlDown
                       If Cells(Z, "B").Value <> N Then
                          Z = Z + 1
                       Else
                          If Q <= Cells(Z, "J").Value Then
                             Cells(Z, "J").Value = Cells(Z, "J").Value
                             If Cells(Z, "F") <= D Then
                                Msg = Msg + "/" + CStr(N) + ":essayer de rapprocher la date de livraison"
                             Else
                                Msg = Msg + "/" + CStr(N) + ":ok attente de livraison"
                             End If

                          Else
                             If Cells(Z, "F") <= D Then
                                Q = Q - Cells(Z, "J")
                                Cells(Z, "J").Value = 0
                                Msg = Msg + "/" + N + ":" + CStr(Q) + "A commander"
                            Else
                               Q = Q - Cells(Z, "J")
                               Cells(Z, "J").Value = 0
                               Msg = Msg + "/" + N + ":rapprocher la date de livraison et" + CStr(Q) + "reste à commander"
                            End If

                       End If
                       Exit Do
                   End If
                 Loop
             Else
                 If Q <= Cells(y, "H").Value Then
                    Cells(y, "H").Value = Cells(y, "H").Value - Q
                    'Activation planif.
                    Worksheets("PLANIF").Activate
                    Msg = Msg + "/" + CStr(N) + ":OK"
                        Exit For
                 Else
                    Q = Q - Cells(y, "H").Value
                    Cells(y, "H").Value = 0
                    If Q <= Cells(y, "i").Value Then
                        Cells(y, "i").Value = Cells(y, "i").Value - Q
                        'Activation planif
                        Worksheets("PLANIF").Activate
                        Msg = Msg + "/" + "vérifier la date de libération de" + CStr(Q) + CStr(N)
                        Exit For
                    Else
                        Q = Q - Cells(y, "i").Value
                        Cells(y, "i").Value = 0
                        'activation CA
                        Worksheets("CA").Activate
                        Z = 2
                        Do While Z <= xlDown
                            If Cells(Z, "B").Value <> N Then
                               Z = Z + 1
                            Else
                                If Q <= Cells(Z, "J").Value Then
                                   Cells(Z, "J").Value = Cells(Z, "J").Value
                                   If Cells(Z, "F") <= D Then
                                      Msg = Msg + "/" + CStr(N) + ":essayer de rapprocher la date de livraison"
                                   Else
                                      Msg = Msg + "/" + CStr(N) + ":ok attente de livraison"
                                   End If

                                Else
                                   If Cells(Z, "F") <= D Then
                                      Q = Q - Cells(Z, "J")
                                      Cells(Z, "J").Value = 0
                                      Msg = Msg + "/" + N + ":" + CStr(Q) + "A commander"
                                   Else
                                      Q = Q - Cells(Z, "J")
                                      Cells(Z, "J").Value = 0
                                      Msg = Msg + "/" + N + ":rapprocher la date de livraison et" + CStr(Q) + "reste à commander"
                                   End If

                                End If
                                Exit Do
                            End If
                            Exit For
                        Loop
                        If Z = xlDown + 1 Then
                            Msg = Msg + "/" + N + ":" + CStr(Q) + "à commander"
                            Exit For
                        End If
                    End If
                End If
           End If
          End If
       Next y
'attention
   Else  'pso comme composant
     'Activer nomenc.
     Worksheets("Nomenclatures").Activate
     w = 2
     While Cells(w, "B").Value <> N
        w = w + 1
     Wend
     'Boucle while pour savoir la ligne du premier composant
     Nomenclature.Range("A1:N1").AutoFilter field:=2, Criteria1:=N
     'Traitement avec W jusqu'à xlDown
     For E = w To xlDown
       Dim CP As String
       CP = Cells(E, "H").Value

       Q = Cells(E, "i").Value * (QT / TL) 'quantité du composant dans la QT

       'activer magasin
       Worksheets("MAGASIN").Activate
       For x = 2 To xlDown
          If Cells(x, "B").Value = CP Then

             If Cells(x, "P").Value <= D Then ' date peremption
                'Activation CA
                Worksheets("CA").Activate
                Z = 2
                Do While Z <= xlDown
                    If Cells(Z, "B").Value <> N Then
                        Z = Z + 1
                    Else
                        If Q <= Cells(Z, "J").Value Then
                           Cells(Z, "J").Value = Cells(Z, "J").Value
                           If Cells(Z, "F") <= D Then
                               Msg = Msg + "/" + CStr(N) + ":essayer de rapprocher la date de livraison"
                           Else
                               Msg = Msg + "/" + CStr(N) + ":ok attente de livraison"
                           End If

                        Else
                           If Cells(Z, "F") <= D Then
                               Q = Q - Cells(Z, "J")
                               Cells(Z, "J").Value = 0
                               Msg = Msg + "/" + N + ":" + CStr(Q) + "A commander"
                           Else
                               Q = Q - Cells(Z, "J")
                               Cells(Z, "J").Value = 0
                               Msg = Msg + "/" + N + ":rapprocher la date de livraison et" + CStr(Q) + "reste à commander"
                           End If

                        End If
                        Exit Do
                    End If
                Loop
             Else
                If Q <= Cells(x, "H").Value Then
                     Cells(x, "H").Value = Cells(x, "H").Value - Q
                     'Activation planif.
                     Worksheets("PLANIF").Activate
                     Msg = Msg + "/" + CStr(CP) + ":OK"
                     Exit For
                Else
                     Q = Q - Cells(x, "H").Value
                     Cells(x, "H").Value = 0
                     If Q <= Cells(x, "i").Value Then
                         Cells(x, "i").Value = Cells(x, "i").Value - Q
                         'Activation planif
                         Worksheets("PLANIF").Activate
                         Msg = Msg + "/" + "vérifier la date de libération de" + CStr(Q) + CStr(CP)
                         Exit For
                     Else
                         Q = Q - Cells(x, "i").Value
                         Cells(x, "i").Value = 0
                         'activation CA
                         Worksheets("CA").Activate
                         Z = 2
                         Do While Z <= xlDown
                            If Cells(Z, "B").Value <> CP Then
                               Z = Z + 1
                            Else
                               If Q <= Cells(Z, "J").Value Then
                                   Cells(Z, "J").Value = Cells(Z, "J").Value
                                   If Cells(Z, "F") <= D Then
                                      Msg = Msg + "/" + CStr(CP) + ":essayer de rapprocher la date de livraison"
                                   Else
                                      Msg = Msg + "/" + CStr(CP) + ":ok attente de livraison"
                                   End If

                               Else
                                   If Cells(Z, "F") <= D Then
                                      Q = Q - Cells(Z, "J")
                                      Cells(Z, "J").Value = 0
                                      Msg = Msg + "/" + CP + ":" + CStr(Q) + "A commander"
                                   Else
                                      Q = Q - Cells(Z, "J")
                                      Cells(Z, "J").Value = 0
                                      Msg = Msg + "/" + CP + ":rapprocher la date de livraison et" + CStr(Q) + "reste à commander"
                                   End If

                               End If
                               Exit Do
                            End If
                            Exit For
                         Loop
                     End If
                     If Z = xlDown + 1 Then
                        Msg = Msg + "/" + CP + ":" + CStr(Q) + "à commander"
                        Exit For
                     End If
                End If
             End If
          End If

      Next x
     Next E
   End If
Next u
  End If
Next i
End Sub

Bonjour,

tu as oublié de mettre le fichier le plus important (celui qui contient ta macro) et de nous indiquer l'instruction qui provoque l'erreur.

Je mettrais une pièce sur l'instruction range("A1 :Q" & xldown).sort

si tu n'as pas redéfini xldown par ailleurs, cette variable contient -4121 et non pas l'indice de la dernière ligne utilisée dans ta feuille. Cette valeur est incorrecte pour une instruction range.

Rechercher des sujets similaires à "probleme erreur 1004"