Erreur d’exécution '1004' Do While Range
Bonjour,
Je permets de vous solliciter car j'ai une erreur sur une macro.
J'utilise des macro dans un dossier de travail et en général j'arrive à résoudre les erreurs mais la je suis bloqué.
Voici ci-dessous ce qui pose problème :
If Result <> "" Then
Sheets(Montab(Result, 1)).Activate
Sheets(Montab(Result, 1)).Visible = True
J = 19
Do While Range("A" & J).Value <> Montab(Result, 2)
J = J + 1
Loop
et plus particulièrement : Do While Range("A" & J).Value <> Montab(Result, 2)
En effet lorsque j'appuie sur le bouton Alimentation feuille maîtresses de l'onglet ENTETE , une erreur se produit et la ventilation des comptes ne s'effectue pas.
Merci par avance pour votre aide
bonjour,
regarde si tu n'as pas une cellule en erreur en colonne A de la feuille en question.
Bonjour
Merci pour votre retour.
A priori, non mais peut-être que je cherche pas au bon endroit.
J'aimerais mettre le fichier en pièce jointe mais il est trop lourd (4 Mo en zip)
Comment puis vous le transmettre ? enfin si c'est possible
Merci
Bonjour,
Et avec :
Do While Range("A" & j).Value <> Montab(Result, 2) And j <= Rows.Count
Bonjour,
Merci pour votre aide.
Malheureusement cela ne semble pas fonctionner.
Vous trouverez ci-dessous le fichier a télécharger via wetransfert (Car trop volumineux 7mo) si besoin
encore merci
Bonsoir,
le message est la conséquence de la variable J ayant atteint le maximum pour un numéro de ligne, comme l'a pensé Patrice33740.
Ce problème survient quand la valeur recherchée (montab(result,2) en l'occurrence la valeur K1) n'est pas trouvée en colonne A de la feuille en cours.
Merci pour votre retour.
Que dois-je modifier pour que l'erreur soit réparée ?
Merci pour votre aide
Bonsoir,
que faut-il faire quand le valeur n'est pas trouvée ? le programme se plante parce que ce cas n'est pas prévu.
Bonjour
Merci pour votre retour.
Je ne suis pas le concepteur de ce fichier mais on l'adapte pour nos besoins.
Désolé mais je ne vois pas la valeur manquante. (Dans quel onglet ? )
Sinon on peut passer outre je pense.
Bonjour,
Je n'ouvre pas les fichiers joints, en particulier lorsqu'ils contiennent des macros.
Si tu modifies le code comme je te l'ai proposé, il ne devrait plus se produire l'erreur signalée.
Tu as simplement dit : « ça ne semble pas fonctionner », c'est vague comme réponse !
Est-ce simplement que le résultat attendu ne correspond pas ou bien y-a-t'il toujours une erreur, si oui laquelle ?
Bonjour,
Merci pour votre retour.
Malheureusement si, l'erreur persiste malgré la modification du code.
bonjour,
pour éviter l'erreur sur cette ligne tu peux adapter le code ainsi
Do While Range("A" & j).Value <> Montab(Result, 2) And j < Rows.Count
je n'ai aucune idée des conséquences de cette modification sur la suite du traitement, et je n'ai pas envie de faire le reverse engineering de ton classeur et de ses macros, pour en comprendre la logique et les tenants et aboutissants.
Re,
Effectivement c'est inférieur au lieu de inférieur ou égal.
Do While Range("A" & j).Value <> Montab(result, 2) And j < Rows.Count
Bonjour,
Merci pour votre retour.
Effectivement, je n'ai plus d'erreur sur cette macro.
Mais cela a créée une erreur sur la macro suivante :
Ligne_Insert1 = Montab(Result, 3)
Sheets(Montab(Result, 1)).Range("A" & Ligne_Insert1).Value = Sheets("BALANCE").Range("A" & I).Value
Ligne_Insert2 = Ligne_Insert1 + 1
Sheets(Montab(Result, 1)).Rows(Ligne_Insert1 & ":" & Ligne_Insert1).Activate
Selection.EntireRow.Hidden = False
L'erreur porte sur : Ligne_Insert2 = Ligne_Insert1 + 1
Le message d'erreur est le suivant : Erreur d'execution '6':
Dépassement de capacité
bonjour,
à nouveau, une indication pour corriger ce problème spécifique
remplace ceci
Sub Main()
Application.ScreenUpdating = False
Dim Counter, V1, I, J, K, Ligne_Insert1, Ligne_Insert2 As Integer
par ceci
Sub Main()
Application.ScreenUpdating = False
Dim Counter&, V1&, I&, J&, K&, Ligne_Insert1&, Ligne_Insert2&
pour comprendre d'où vient le problème, un problème de donnée manquante dans certaines feuilles, voici une adaptation du code (prends bien une sauvegarde avant d'exécuter ce code !).
Sub Main()
Application.ScreenUpdating = False
Dim Counter, V1, I, J, K, Ligne_Insert1, Ligne_Insert2 As Integer
Dim Compte, Affectation, Affectation2 As String
Dim Result, Result2, Compte2, Compte3, Compte4 As Integer
Dim Montab(1 To 10000, 1 To 6) As Variant
Dim Montab2() As Integer 'stocke les valeurs de lignes d'insertion
Dim ValTest2, Msg
Dim base As String
Dim synthese As String
Dim PctDone As Single
Dim LimitK&, LimitJ&
'UserForm2.Show
'Unload UserForm2
'If Range("aq1") = "expert" Then
'base = "ref"
'Sheets("SYNTHESE").Visible = True
'Sheets("SOMMAIRE").Visible = True
'Sheets("ref").Visible = True
'Else
base = "Ref"
Sheets("SYNTHESE").Visible = True
Sheets("SOMMAIRE").Visible = True
Sheets("ref").Visible = True
'End If
Counter = 5
Sheets("BALANCE").Activate
While Not Range("B" & Counter) = ""
Counter = Counter + 1
Wend
Counter = Counter - 1
'vérification si c'est le premier moulinage et recopie des affectations de cycle
'Effacer les affectations
Sheets("BALANCE").Activate
Range("W5:X2000").Select
Selection.ClearContents
'--------
Sheets("ENTETE").Select
Dim numerobalance As Integer
numerobalance = Range("P5")
Sheets("BALANCE (2)").Visible = True
If numerobalance > 1 Then
Sheets("BALANCE").Select
Range("w5").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-22],'BALANCE (2)'!R5C1:R2037C24,23,FALSE))=TRUE,"""",IF(VLOOKUP(RC[-22],'BALANCE (2)'!R5C1:R2037C24,23,FALSE)="""","""",VLOOKUP(RC[-22],'BALANCE (2)'!R5C1:R2037C24,23,FALSE)))"
Selection.Copy
Range("w" & 6 & ":" & "w" & Counter).Select
ActiveSheet.Paste
Range("X5").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-23],'BALANCE (2)'!R5C1:R2037C24,24,FALSE))=TRUE,"""",IF(VLOOKUP(RC[-23],'BALANCE (2)'!R5C1:R2037C24,24,FALSE)="""","""",VLOOKUP(RC[-23],'BALANCE (2)'!R5C1:R2037C24,24,FALSE)))"
Range("X" & 6 & ":" & "X" & Counter).Select
ActiveSheet.Paste
Sheets("BALANCE (2)").Visible = False
Else
Sheets("BALANCE (2)").Select
Range("a5:H10000").Select
Selection.ClearContents
Range("w5:x10000").Select
Selection.ClearContents
End If
'---------------------
Sheets(base).Activate
I = 2
l = 1
J = 15
K = 15
Do While Range("A" & I) <> ""
V1 = Range("A" & I).Value
Montab(V1, 1) = Range("B" & I).Value
Montab(V1, 2) = Range("C" & I).Value
Montab(V1, 4) = Range("D" & I).Value
Montab(V1, 5) = Range("E" & I).Value
I = I + 1
Loop
For I = 5 To Counter
Compte = Sheets("BALANCE").Range("A" & I).Value
Compte2 = Left(Compte, 2)
Compte3 = Left(Compte, 3)
Compte4 = Left(Compte, 4)
Affectation = Sheets("BALANCE").Range("W" & I).Value
Affectation2 = ""
If (Montab(Compte2, 1) <> "" And Affectation = "") = True Then
Result = Compte2
ElseIf (Montab(Compte3, 1) <> "" And Affectation = "") = True Then
Result = Compte3
ElseIf (Montab(Compte4, 1) <> "" And Affectation = "") = True Then
Result = Compte4
Else: Result = ""
End If
If (Montab(Compte2, 4) <> "" And Affectation = "") = True Then
Result2 = Compte2
ElseIf (Montab(Compte3, 4) <> "" And Affectation = "") = True Then
Result2 = Compte3
ElseIf (Montab(Compte4, 4) <> "" And Affectation = "") = True Then
Result2 = Compte4
Else: Result2 = ""
End If
'Première procédure pour insertion dans première lead
If Result <> "" Then
Sheets(Montab(Result, 1)).Activate
Sheets(Montab(Result, 1)).Visible = True
J = 19
LimitJ = Cells(Rows.Count, 1).End(xlUp).Row
Do While Range("A" & J).Value <> Montab(Result, 2) And J < LimitJ
J = J + 1
Loop
If J + 1 < LimitJ Then
Montab(Result, 3) = J - 3
Affectation2 = Montab(Result, 1)
'Ajout du nouveau compte dans lead
Ligne_Insert1 = Montab(Result, 3)
Sheets(Montab(Result, 1)).Range("A" & Ligne_Insert1).Value = Sheets("BALANCE").Range("A" & I).Value
Ligne_Insert2 = Ligne_Insert1 + 1
Sheets(Montab(Result, 1)).Rows(Ligne_Insert1 & ":" & Ligne_Insert1).Activate
Selection.EntireRow.Hidden = False
'Ajout d'une nouvelle ligne dans la lead et masquage
Rows(Ligne_Insert2 & ":" & Ligne_Insert2).Select
Selection.Insert Shift:=xlDown
Selection.EntireRow.Hidden = True
Range("B" & Ligne_Insert1 & ":" & "J" & Ligne_Insert1).Select
Selection.Copy
Range("B" & Ligne_Insert2 & ":" & "J" & Ligne_Insert2).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Montab(Result, 3) = Ligne_Insert2
Range("A1").Select
Else
MsgBox "valeur " & Montab(Result, 2) & " non trouvée après la ligne 18 en colonne A dans la feuille " & ActiveSheet.Name
End If
End If
'Seconde procédure pour insertion dans seconde lead
If Result2 <> "" Then
Sheets(Montab(Result2, 4)).Activate
Sheets(Montab(Result2, 4)).Visible = True
K = 19
LimitK = Cells(Rows.Count, 1).End(xlUp).Row
Do While Range("A" & K).Value <> Montab(Result2, 5) And K < LimitK
K = K + 1
Loop
If K + 1 < LimitK Then
Montab(Result2, 6) = K - 3
Affectation2 = Affectation2
'& "/" & Montab(Result2, 4)
Affectation = Montab(Result2, 4)
'Ajout du nouveau compte dans lead
Ligne_Insert1 = Montab(Result2, 6)
Sheets(Montab(Result2, 4)).Range("A" & Ligne_Insert1).Value = Sheets("BALANCE").Range("A" & I).Value
Ligne_Insert2 = Ligne_Insert1 + 1
Sheets(Montab(Result2, 4)).Rows(Ligne_Insert1 & ":" & Ligne_Insert1).Activate
Selection.EntireRow.Hidden = False
'Ajout d'une nouvelle ligne dans la lead et masquage
Rows(Ligne_Insert2 & ":" & Ligne_Insert2).Select
Selection.Insert Shift:=xlDown
Selection.EntireRow.Hidden = True
Range("B" & Ligne_Insert1 & ":" & "J" & Ligne_Insert1).Select
Selection.Copy
Range("B" & Ligne_Insert2 & ":" & "J" & Ligne_Insert2).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Montab(Result2, 6) = Ligne_Insert2
Range("A1").Select
Else
MsgBox "valeur " & Montab(Result, 5) & " non trouvée après la ligne 18 en colonne A dans la feuille " & ActiveSheet.Name
End If
End If
If Result <> "" Then
Sheets("BALANCE").Range("W" & I) = Affectation2
Sheets("BALANCE").Range("X" & I) = Affectation
End If
PctDone = I / Counter
UpdateProgressBar PctDone
Next I
Unload UserForm1
'Sheets("Bilan").Activate
'Sheets("Bilan").Visible = True
'ValTest2 = Sheets("Bilan").Range("C90").Value
'ValTest2 = Round(ValTest2, 2)
'If ValTest2 = 0 Then
' Msg = MsgBox("Le bilan au " & Sheets("Données").Range("B6").Value & " est équilibré")
'Else: Msg = MsgBox("Le bilan n'est pas équilibré")
'End If
Sheets("BALANCE (2)").Visible = False
Sheets("REF").Visible = False
Sheets("ENTETE").Select
MsgBox "Traitement terminé.", vbExclamation, "Message"
MsgBox "Il faut renseigner les variations des cycles IMMOBILISATIONS - PROV RISQUE ET CHARGE - FONDS PROPRES dans chaque onglet.", vbExclamation, "Message"
End Sub
Bonjour
Je tenais a vous remercier pour la réécriture du code et vous prie de bien vouloir m'excuser pour mon retour tardif.
Ce dernier fonctionne très bien.
Encore merci.
Je vous souhaite une excellente journée.