Erreur d'éxécution '91' variable objet ou variable de bloc with non définie

Bonjour les amis,

Le fichier sur lequel je travail est finalisé pratiquement, j'ai un plantage à la fin du traitement (Erreur d'éxécution '91' variable objet ou variable de bloc with non définie), je ne vois vraiment pas à quoi ça correspond. Si quelqu'un pourrais m'aider ça serait magnifique

Voilà le code :

Sub ExtraireParGroupeColonneB()

Dim O As Long, NbLg As Long
Dim n As Integer
Dim H1 As Worksheet
Dim Mondico As Object
Dim Tablo
Dim Interdits
Dim ligne

Call RegrouperLesBD

  Interdits = Array("&", ":", "/", "\", "~?", "~*", "[", "]", Chr(34))

  Application.ScreenUpdating = False

  Application.DisplayAlerts = False

  Application.DisplayAlerts = True

  Call SupprimeFeuille

  Set H1 = Sheets("BD")
  If H1.FilterMode = True Then H1.ShowAllData
  NbLg = H1.Range("A" & Rows.Count).End(xlUp).Row

rep = InputBox("Choisir la lettre de la colonne pour la création de fiches", "CREATION DE FICHES PAR GROUPES", "B")

  H1.Columns(rep).Copy H1.Columns("O")

  With H1.Range("O2:O" & NbLg)
    For n = 0 To UBound(Interdits)
      .Replace what:=Interdits(n), replacement:="_", lookat:=xlPart
    Next n

  End With

  Set Mondico = CreateObject("Scripting.dictionary")
  For O = 2 To NbLg
    Mondico(H1.Range("O" & O).Value) = ""
  Next O

  H1.Range("O1:P1") = "XYZ"

  Tablo = Mondico.keys
  For n = 0 To UBound(Tablo)
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = Tablo(n)
    Sheets("Modèle").UsedRange.Copy
    Sheets(Tablo(n)).Range("A1").PasteSpecial

    With Sheets(Tablo(n))
      .Range("A2") = Tablo(n)
      H1.Range("P2") = Tablo(n)

        For Each cel In H1.Range("G2:G" & NbLg) 'pour chaque cellule de G2 à G_DernièreLigne
            r = cel.Row
            noms = H1.Range("C" & r)
            If H1.Range(rep & r) = Tablo(n) Then
                c = .Range("A1000").End(xlUp).Row + 1
                If .Range("A9") = "" Then
                    H1.Range("C" & r & ":H" & r).Copy 'Copie de C à H feuille BD
                    .Range("A" & c).PasteSpecial xlPasteValues 'Colle depuis A feuille modèle
                End If

                If Not .Range("E9:E" & c).Find(cel) Is Nothing And Not .Range("A9:A" & c).Find(noms) Is Nothing Then
                'Si le numero de pièce existe déjà dans la feuille modèle alors...
                Set ligne = .Range("E9:E" & c).Find(cel) 'on trouve la ligne correspondante
                    If Not ligne Is Nothing And .Range("A" & ligne.Row) <> noms Then
                        Flig = ligne.Row
                        Do
                            cel.Value = cel
                            Set ligne = .Range("E9:E" & c).FindNext(.Range("E" & Flig))
                            ligne = ligne.Row
                        Loop While ligne = Flig And .Range("A" & ligne) <> noms
                    Else
                    ligne = ligne.Row
                    End If
remp:
                    'On prend chaque cas de compte et on vient mettre le débit et crédit dans les colonnes correspondantes
                    If H1.Range("A" & r) = "VACANCES - COLOS" Then .Range("G" & ligne) = .Range("G" & ligne) + H1.Range("I" & r): .Range("H" & ligne) = .Range("H" & ligne) + H1.Range("J" & r)
                    If H1.Range("A" & r) = "ALIMENTATION A L'EXTERIEUR." Then .Range("I" & ligne) = .Range("I" & ligne) + H1.Range("I" & r): .Range("J" & ligne) = .Range("J" & ligne) + H1.Range("J" & r)
                    If H1.Range("A" & r) = "AUTRES REMB.FRAIS GR 1" Then .Range("N" & ligne) = .Range("N" & ligne) + H1.Range("J" & r): .Range("M" & ligne) = .Range("M" & ligne) + H1.Range("I" & r)
                Else
                    H1.Range("C" & r & ":H" & r).Copy
                    .Range("A" & c).PasteSpecial xlPasteValues
                    ligne = c
                    GoTo remp
                End If

            End If

        Next cel

           ActiveWindow.DisplayOutline = False

    End With

      'ICI AJUSTER LIGNES ET COLONNES
    Call MiseEnPageFeuilleModeleColonnesEtLignes

  Next n

  H1.Columns("O:P").Clear
  H1.Select

  Call consolidation
  Call consolidation

End Sub

Bonjour,

quand ce message s'affiche et que tu choisis débogage, vers quelle ligne VBA te ramène?

Peux tu joindre ton fichier pour qu'on puisse t'aider? Analyser un programme en VBA je sais faire, mais pas sans le débogage...

Tout d'abord merci pour ta réponse, j'aurai aimé y ajouter un fichier mais il fait 7mo et visiblement ça ne passe pas. As tu une adresse mail ? Ou le mieux est de réduire au maximum le fichier pour pouvoir l'envoyer ?

Qu'en penses tu ?

Bonjour,

malheureusement je ne pourrai pas te répondre si tu m'envoie un message sur ma boite mail personnelle, le mieux pour moi serait que tu essayes de réduire la taille de ton fichier en laissant un fichier exemple avec le mínimum d'informations nécessaires (enlever les feuilles qui ne servent pas, réduire le nombre de lignes etc...)

Merci de prendre le temps de faire ça

J'ai justement retravaillé le fichier pour qu'il soit téléchargeable facilement sur ce site et je vais resumer pour mieux comprendre :

ETAPE 1 : FONCTIONNE PARFAITEMENT DONC RIEN A FAIRE A CE NIVEAU

A partir d'une base de donnée (BD), la macro permet de créer des fiches par groupe selon un modèle vierge (Modèle)

ETAPE 2 : RESTE A FAIRE POUR EVITER L'ERREUR D'EXECUTION '91

consolidation de ces fiches dans un tableau récapitulatif.

FICHIER REDUIT AU MAXIMUM :

CAPTURES D'ECRAN :

capture1 capture2 capture3 capture4

Merci infiniment pour votre aide

Rebonjour!

Merci d'avoir réduit la taille du fichier

Malheureusement j'ai encore un soucis... (et oui )

Il n'y a plus aucun programme dans ton fichier, du coup je ne peux plus rien analyser

Serait-il posible de mettre tous tes programmes dans ton fichier ou bien cela le rend trop lourd?

Désolé encore de te demander de me renvoyer quelque chose de plus complet après avoir demandé d'épurer au máximum...

Oups autant pour moi, désolé.

Voici le code qui permet d'extraire toutes les lignes depuis la base de données BD afin de créer des fiches par groupe pour ensuite consolider le tout dans un tableau récapitulatif.

Sub ExtraireParGroupeColonneB()
Dim O As Long, NbLg As Long
Dim n As Integer
Dim H1 As Worksheet
Dim Mondico As Object
Dim Tablo
Dim Interdits
Dim ligne

' Call RegrouperLesBD

  Interdits = Array("&", ":", "/", "\", "~?", "~*", "[", "]", Chr(34))

  Application.ScreenUpdating = False

  Application.DisplayAlerts = False

  Application.DisplayAlerts = True

'  Call SupprimeFeuille

  Set H1 = Sheets("BD")
  If H1.FilterMode = True Then H1.ShowAllData
  NbLg = H1.Range("A" & Rows.Count).End(xlUp).Row

rep = InputBox("Choisir la lettre de la colonne pour la création de fiches", "CREATION DE FICHES PAR GROUPES", "B")

  H1.Columns(rep).Copy H1.Columns("O")

  With H1.Range("O2:O" & NbLg)
    For n = 0 To UBound(Interdits)
      .Replace what:=Interdits(n), replacement:="_", lookat:=xlPart
    Next n

  End With

  Set Mondico = CreateObject("Scripting.dictionary")
  For O = 2 To NbLg
    Mondico(H1.Range("O" & O).Value) = ""
  Next O

  H1.Range("O1:P1") = "XYZ"

  Tablo = Mondico.keys
  For n = 0 To UBound(Tablo)
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = Tablo(n)
    Sheets("Modèle").UsedRange.Copy
    Sheets(Tablo(n)).Range("A1").PasteSpecial

    With Sheets(Tablo(n))
      .Range("A2") = Tablo(n)
      H1.Range("P2") = Tablo(n)

        For Each cel In H1.Range("G2:G" & NbLg) 'pour chaque cellule de G2 à G_DernièreLigne
            r = cel.Row
            noms = H1.Range("C" & r)
            If H1.Range(rep & r) = Tablo(n) Then
                c = .Range("A1000").End(xlUp).Row + 1
                If .Range("A9") = "" Then
                    H1.Range("C" & r & ":H" & r).Copy 'Copie de C à H feuille BD
                    .Range("A" & c).PasteSpecial xlPasteValues 'Colle depuis A feuille modèle
                End If

                If Not .Range("E9:E" & c).Find(cel) Is Nothing And Not .Range("A9:A" & c).Find(noms) Is Nothing Then
                'Si le numero de pièce existe déjà dans la feuille modèle alors...
                Set ligne = .Range("E9:E" & c).Find(cel) 'on trouve la ligne correspondante
                    If Not ligne Is Nothing And .Range("A" & ligne.Row) <> noms Then
                        Flig = ligne.Row
                        Do
                            cel.Value = cel
                            Set ligne = .Range("E9:E" & c).FindNext(.Range("E" & Flig))
                            ligne = ligne.Row
                        Loop While ligne = Flig And .Range("A" & ligne) <> noms
                    Else
                    ligne = ligne.Row
                    End If
remp:
                    'On prend chaque cas de compte et on vient mettre le débit et crédit dans les colonnes correspondantes
                    If H1.Range("A" & r) = "VACANCES - COLOS" Then .Range("G" & ligne) = .Range("G" & ligne) + H1.Range("I" & r): .Range("H" & ligne) = .Range("H" & ligne) + H1.Range("J" & r)
                    If H1.Range("A" & r) = "ALIMENTATION A L'EXTERIEUR." Then .Range("I" & ligne) = .Range("I" & ligne) + H1.Range("I" & r): .Range("J" & ligne) = .Range("J" & ligne) + H1.Range("J" & r)
                    If H1.Range("A" & r) = "AUTRES REMB.FRAIS GR 1" Then .Range("N" & ligne) = .Range("N" & ligne) + H1.Range("J" & r): .Range("M" & ligne) = .Range("M" & ligne) + H1.Range("I" & r)
                Else
                    H1.Range("C" & r & ":H" & r).Copy
                    .Range("A" & c).PasteSpecial xlPasteValues
                    ligne = c
                    GoTo remp
                End If

            End If

        Next cel

           ActiveWindow.DisplayOutline = False

    End With

      'ICI AJUSTER LIGNES ET COLONNES

  '  Call MiseEnPageFeuilleModeleColonnesEtLignes

  Next n

  H1.Columns("O:P").Clear
  H1.Select

 ' Call consolidation

End Sub

Je viens de tester ton programme sans les fonctions, et aucun code d'erreur ne m'est renvoyé, tu dis que ton erreur vient de la fin de ton programme, viendrait-elle de ton call consolidation?

Je ne peux malheureusement pas vérifier si tes fonctions sont biens appellées et bien nommées comme je ne les ai pas. Tu veux que j'essaye de faire un programme de consolidation? parce que je ne peux pas trop avancer sur ton soucis même avec ce que tu m'as transmis, il me semble que le problème vient de l'une de tes fonctions, et je n'ai pas leur code

En tout cas, ton code d'erreur me fait penser à ce type de problème, un nom de programme qui n'est pas le même, une variable à passer qui ne l'est pas, une faute de syntaxe, un objet appelé qui n'existe pas ou qui ne porte pas le même nom etc...

Enfin on avance, on avance

Le plus simple je pense est de faire un programme de consolidation si cela ne te prends pas trop de temps.

Je te rappelle la logique de ce fichier dans son ensemble, créer des fiches par groupe (ARTISTES, PAPILLONS) pour enfin faire un tableau consolidé.

Ok je vais voir ce que je peux faire avec les connaissances (limitées) que j'ai en VBA, je te tiens au courant quand j'aurai finis.

Parfait, merci infiniment. J'ai hâte de voir le résultat

Fiou je ne suis pas en forme aujourd'hui, j'ai mis pas mal de temps mais j'ai finis par faire quelque chose avec de jolis copier coller.

Voici le résultat avec le programme commenté :

Il y a sûrement moyen de proceder plus rapidement mais j'avais envie d'utiliser les copier coller car c'est quand même assez pratique.

J'espère que ça te conviendra

Tout d'abord je te remercie beaucoup pour le travail que tu viens de faire, je vais regarder avec précision tout ça et je reviens vers toi rapidement.

Merci encore mais ça semble bien fonctionner, de plus, merci d'avoir bien expliquer ton programme, ça me permettra de mieux comprendre...

A plus tard

Tout d'abord je te remercie beaucoup pour le travail que tu viens de faire, je vais regarder avec précision tout ça et je reviens vers toi rapidement.

Merci encore mais ça semble bien fonctionner, de plus, merci d'avoir bien expliquer ton programme, ça me permettra de mieux comprendre...

A plus tard

De rien!

C'est normal que je le commente même si ça prend du temps en plus pour répondre

Pour mieux aider la personne, il faut essayer de lui faire comprendre ce qu'on a fait, je propose souvent d'expliquer aux personnes ce que j'ai fait quand je réponds à un post. Ça m'est déjà arrivé d'atterir sur le programme de quelqu'un qui ne commente rien et c'est dur de s'y retrouver, et pour comprendre... c'est encore pire...

Du coup j'essaye de prendre cette habitude, après tout si on est là c'est pour aider

Le traitement fonctionne très bien, par contre, peut-on imaginer un traitement de ton programme uniquement sur les onglets commençant par "F_" ?

Je te dis sa parce que nous avons traiter un exemple avec 2 groupes (ARTISTES et PAPILLONS) mais il existe plusieurs autres groupes. Voilà pourquoi si on pouvait activer ton programme uniquement avec les onglets qui commence par "F_", sa serait magnifique.

Hum ça doit être posible mais à creuser, je vais voir de mon côté demain si c'est possible ou non

ok sa marche, merci encore et à demain

Bonjour à tous,

À tester :

Peu importe le nombre de feuilles dont le nom commence par F_

Peu importe le nombre de lignes de chaque feuilles dont le nom commence par F_

Le nombre de colonnes est limité par la variable : NbCol = 16

Sub Consolidation()

Dim NbLig, NbLig2, DerLig, DerLigCF, DerLigCF2, NbCol As Integer    ' déclarer les variables
Dim X, Y As Integer   ' déclarer les variables
Dim Sh As Worksheet   ' déclarer les variables

Application.ScreenUpdating = False  ' désactive l'affichage pour augmenter la vitesse d'exécution (se réactive automatiquement à la fin de la macro)

NbLig = 0                                   's'assurer que la variable est à 0
For Each Sh In ThisWorkbook.Worksheets      ' pour chacune des feuilles (compter le nombre de lignes à être copier)
    If Left(Sh.Name, 2) = "F_" Then         ' si le nom de la feuilles commence par F_
        DerLig = Sh.Cells(Rows.Count, 1).End(xlUp).Row  ' trouve la dernière ligne
        NbLig = NbLig + (DerLig - 8)                    ' compte le nombre de lignes pour toutes feuilles commençant F_
    End If
Next Sh         'boucle sur les feuilles

NbCol = 16      'détermine le nombre de colonne (pourra éventuellement être variable)

    'Initialisation de la feuille de consolidation
With Worksheets("CONSOLIDATION FICHES")    'le With sert à dimuner les écritures
    .Select                 'faire précéder du . pour se référer à la feuille mentionnée avec With
    .Range("A3").Select     'place le focus
    DerLigCF = .Range("B" & Rows.Count).End(xlUp).Row   'on voit jusqu'où était remplis le tableau
    .Range("A5:A" & DerLigCF).EntireRow.Value = ""      'On vide le tableau
    .Range("A7:A" & DerLigCF).EntireRow.Delete Shift:=xlUp      'on supprime les lignes du tableau, moins 2 pour conserver les formules TOTAUX
    .Range("B6:B" & NbLig + 5 - 2).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromAbove 'On insère le nomble de lignes compter précédamment

    For Each Sh In ThisWorkbook.Worksheets      'pour chacune des feuilles du classeur
        If Left(Sh.Name, 2) = "F_" Then         'si le nom commence par F_
            NbLig2 = 0                          's'assurer que la variable est à 0
            DerLig = Sh.Cells(Rows.Count, 1).End(xlUp).Row      ' trouve la dernière ligne
            NbLig2 = NbLig2 + (DerLig - 8)                      ' trouve la nombre de ligne à être copiées

            DerLigCF2 = .Range("B" & Rows.Count).End(xlUp).Row + 1      ' trouve la première ligne libre
            .Range(Cells(DerLigCF2, 1), Cells(DerLigCF2 + NbLig2 - 1, 1)) = Sh.Name  ' copie le nom de la feuille source
            For X = 0 To NbLig2 - 1
                For Y = 1 To NbCol
                    .Cells(DerLigCF2 + X, Y + 1) = Sh.Cells(9 + X, Y)  ' copie les cellules
                Next Y  'boucle
            Next X      'boucle
        End If
    Next Sh     'boucle sur les feuilles
End With        'met fin à la référence
End Sub

ric

Merci ric

J'ai encore beaucoup de mal personnellement à travailler avec les for each... gros blocage dessus, heureusement que tu es passé par là

Merci les amis c'est vraiment sympa de m'avoir aidé sur ce post là, ça fonctionne parfaitement et c'est ce que je voulais, maintenant, j'ai un module presque complet pour finaliser l'application automatiser à la recherche de données afin d'en sortir un tableau récapitulatif.

L'exemple que je vous ai envoyé et notamment les fameuses fiches "ARTISTES" et "PAPILLONS" ont été saisies manuellement, je souhaiterai savoir s'il était possible de modifier le module sur lequel un ami à travailler dessus, et malheureusement, il ne fonctionne pas à chaque fois et je n'arrive vraiment pas à l'adapter.

L'idée de ce module qui ne fonctionne pas comme je le souhaite, est qu'à partir de l'onglet "BD" il créer les fiches automatiquement et que surtour il réparti dans la colonne vacances colo les chiffres correspondant, ensuite dans la colonne alimentation exterieur, il recherche le n° de la pièce correspondant à la colonne vacances colo et qu'il le met bien dans la bonne ligne, et enfin pour la 3e colonne, il recherche aussi le n° de pièce correspondant à la colonne vacances colo et qu'il met le chiffre correspondant.

il y a peut être une simple adaptation à faire...

Il est impossible de le faire avec l'action copier coller.

Pouvez-vous m'aider svp ?

Voici la capture d'écran de ce que je souhaite avoir en automatique :

ecran 3

Voici le code existant :

Sub ExtraireParGroupeColonneB()
Dim O As Long, NbLg As Long
Dim n As Integer
Dim H1 As Worksheet
Dim Mondico As Object
Dim Tablo
Dim Interdits
Dim ligne

  Interdits = Array("&", ":", "/", "\", "~?", "~*", "[", "]", Chr(34))

  Application.ScreenUpdating = False

  Application.DisplayAlerts = False

  Application.DisplayAlerts = True

  Set H1 = Sheets("BD")
  If H1.FilterMode = True Then H1.ShowAllData
  NbLg = H1.Range("A" & Rows.Count).End(xlUp).Row

rep = InputBox("Choisir la lettre de la colonne pour la création de fiches", "CREATION DE FICHES PAR GROUPES", "B")

  H1.Columns(rep).Copy H1.Columns("O")

  With H1.Range("O2:O" & NbLg)
    For n = 0 To UBound(Interdits)
      .Replace what:=Interdits(n), replacement:="_", lookat:=xlPart
    Next n

  End With

  Set Mondico = CreateObject("Scripting.dictionary")
  For O = 2 To NbLg
    Mondico(H1.Range("O" & O).Value) = ""
  Next O

  H1.Range("O1:P1") = "XYZ"

  Tablo = Mondico.keys
  For n = 0 To UBound(Tablo)
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = Tablo(n)
    Sheets("Modèle").UsedRange.Copy
    Sheets(Tablo(n)).Range("A1").PasteSpecial

    With Sheets(Tablo(n))
      .Range("A2") = Tablo(n)
      H1.Range("P2") = Tablo(n)

        For Each cel In H1.Range("G2:G" & NbLg) 'pour chaque cellule de G2 à G_DernièreLigne
            r = cel.Row
            noms = H1.Range("C" & r)
            If H1.Range(rep & r) = Tablo(n) Then
                c = .Range("A1000").End(xlUp).Row + 1
                If .Range("A9") = "" Then
                    H1.Range("C" & r & ":H" & r).Copy 'Copie de C à H feuille BD
                    .Range("A" & c).PasteSpecial xlPasteValues 'Colle depuis A feuille modèle
                End If

                If Not .Range("E9:E" & c).Find(cel) Is Nothing And Not .Range("A9:A" & c).Find(noms) Is Nothing Then
                'Si le numero de pièce existe déjà dans la feuille modèle alors...
                Set ligne = .Range("E9:E" & c).Find(cel) 'on trouve la ligne correspondante
                    If Not ligne Is Nothing And .Range("A" & ligne.Row) <> noms Then
                        Flig = ligne.Row
                        Do
                            cel.Value = cel
                            Set ligne = .Range("E9:E" & c).FindNext(.Range("E" & Flig))
                            ligne = ligne.Row
                        Loop While ligne = Flig And .Range("A" & ligne) <> noms
                    Else
                    ligne = ligne.Row
                    End If
remp:
                    'On prend chaque cas de compte et on vient mettre le débit et crédit dans les colonnes correspondantes
                    If H1.Range("A" & r) = "VACANCES - COLOS" Then .Range("G" & ligne) = .Range("G" & ligne) + H1.Range("I" & r): .Range("H" & ligne) = .Range("H" & ligne) + H1.Range("J" & r)
                    If H1.Range("A" & r) = "ALIMENTATION A L'EXTERIEUR." Then .Range("I" & ligne) = .Range("I" & ligne) + H1.Range("I" & r): .Range("J" & ligne) = .Range("J" & ligne) + H1.Range("J" & r)
                    If H1.Range("A" & r) = "AUTRES REMB.FRAIS GR 1" Then .Range("N" & ligne) = .Range("N" & ligne) + H1.Range("J" & r): .Range("M" & ligne) = .Range("M" & ligne) + H1.Range("I" & r)
                Else
                    H1.Range("C" & r & ":H" & r).Copy
                    .Range("A" & c).PasteSpecial xlPasteValues
                    ligne = c
                    GoTo remp
                End If

            End If

        Next cel

           ActiveWindow.DisplayOutline = False

    End With

      'ICI AJUSTER LIGNES ET COLONNES

    Call MiseEnPageFeuilleModeleColonnesEtLignes

  Next n

  H1.Columns("O:P").Clear
  H1.Select

End Sub
Rechercher des sujets similaires à "erreur execution variable objet bloc definie"