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 :
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 :
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