Erreur d’exécution '1004' Do While Range

Le 11/02/2020 à 14:43

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

Le 11/02/2020 à 14:50

bonjour,

regarde si tu n'as pas une cellule en erreur en colonne A de la feuille en question.

Le 11/02/2020 à 15:24

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

Le 11/02/2020 à 16:16

Bonjour,

Et avec :

Do While Range("A" & j).Value <> Montab(Result, 2) And j <= Rows.Count
Le 11/02/2020 à 16:45

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

https://we.tl/t-jiBZ7cstdJ

encore merci

Le 11/02/2020 à 20:35

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.

Le 11/02/2020 à 22:23

Merci pour votre retour.

Que dois-je modifier pour que l'erreur soit réparée ?

Merci pour votre aide

Le 11/02/2020 à 23:55

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.

Le 12/02/2020 à 09:40

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.

Le 12/02/2020 à 09:57

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 ?

Le 12/02/2020 à 11:10

Bonjour,

Merci pour votre retour.

Malheureusement si, l'erreur persiste malgré la modification du code.

Le 12/02/2020 à 11:29

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.

Le 12/02/2020 à 15:04

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

Le 13/02/2020 à 09:51

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é

Le 13/02/2020 à 11:43

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
Le 17/06/2020 à 10:20

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.

Rechercher des sujets similaires à "erreur execution 1004 while range"