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 :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
 
 
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