Erreur d'execution '91' : Variable objet ou variable de bloc With non définie

Version imprimable

Bonjour,

Voilà je suis nouvelle en VBA et je bloque depuis ce matin à cause d'un problème (cf titre) que je n'arrive pas à résoudre.

L'objectif :

A partir d'une feuille source contenant un tableau, j'aimerais pouvoir créer une nouvelle feuille pour chaque nom différents présents dans une seule des colonnes du tableau. Ensuite il faut copier les lignes de chaque nom, dans la feuille correspondante (qui vient d'être crée à son nom).

- Pour cela j'ai d'abord réalisé un code qui me permet de copier coller sur une nouvelle feuille toutes les lignes qui m'intéresse du tableau de la premiere feuille.

- J'ai ensuite réalisé un code permettant de créer une feuille pour chacun des noms présents dans la colonne du tableau de la premiere feuille.

J'ai donc ensuite essayé de faire un mélange des deux codes pour obtenir mon code final mais c'est là que ca bloque et je ne comprends pas pourquoi :oops:

- Voilà le premier code qui permet de copier coller sur une nouvelle feuille :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Test()
 
Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
 
  Sheets("feuil2").Activate ' feuille de destination
 
  Col = "D"                 ' colonne données non vides à tester'
  NumLig = 0          'Numero de la 1ere ligne de collage '
  With Sheets("feuil1")     ' feuille source'
  NbrLig = .Cells(65536, Col).End(xlUp).Row 'Nombre de ligne
  For Lig = 2 To NbrLig             'n° de la 1ere ligne de données à partir de laquelle on commence jusqu'à NbrLig'
    If .Cells(Lig, Col).Value = "EHCA" Then
      .Cells(Lig, Col).EntireRow.Copy
      NumLig = NumLig + 1
      Sheets("feuil2").Cells(NumLig, 1).Insert Shift:=xlDown
            'ici pour insérer ou  .Paste pour coller'
    End If
  Next
  End With
End Sub

- Voilà maintenant le deuxième code qui permet de créer des nouvelles feuilles :

Code:

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
Option Explicit
 Dim maColonne As Integer

Sub AjoutFeuilles()
 Dim derLi As Long
 Dim i As Integer
 Dim maFeuille As Worksheet
 Set maFeuille = ActiveSheet[/COLOR]
 maColonne = 4  ' numéro de colonne a ajuster, ici c'est 1
 derLi = Columns(maColonne).Find("*", , , , , xlPrevious).Row 'derniere ligne, derli = 13 par ex'
 For i = 2 To derLi ' 2 si ligne de titre
 'Si la feuille existe déjà, on passe à la ligne suivante
 If FeuilleExiste(maFeuille.Cells(i, maColonne)) Then GoTo Suivant
 ' ajout d'une feuille à la fin
 Sheets.Add after:=Sheets(Worksheets.Count)
 ' nom de la feuille = valeur de la cellule
 Sheets(Worksheets.Count).Name = maFeuille.Cells(i, maColonne)
[COLOR=#FF0000]Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
  
Sheets(Worksheets.Count).Activate ' feuille de destination
Col = "D"                 ' colonne données non vides à tester'
  NumLig = 0          'Numero de la 1ere ligne de collage '
  With Sheets("feuil1")     ' feuille source'
  NbrLig = .Cells(65536, Col).End(xlUp).Row 'Nombre de ligne
  For Lig = 2 To NbrLig             'n° de la 1ere ligne de données à partir de laquelle on commence jusqu'à NbrLig'
    If .Cells(Lig, Col).Value = "maFeuille.Cells(i, maColonne)" Then
      .Cells(Lig, Col).EntireRow.Copy
      NumLig = NumLig + 1
      Sheets(Worksheets.Count).Cells(NumLig, 1).Insert Shift:=xlDown
            'ici pour insérer ou  .Paste pour coller'
    End If
  Next
  End With

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
 
 Next
 'on retourne à la feuille d'origine
 maFeuille.Select
 Set maFeuille = Nothing
 End Sub
 Function FeuilleExiste(Nom$) As Boolean 'Ti
 On Error Resume Next
 FeuilleExiste = Sheets(Nom).Name <> ""
 End Function
 Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column = maColonne Then AjoutFeuilles
 End Sub

Et maintenant, le mix des deux codes en changeant quelques variable
bien sur :

Code:

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
Option Explicit
 Dim maColonne As Integer
 
Sub AjoutFeuilles()
 Dim derLi As Long
 Dim i As Integer
 Dim maFeuille As Worksheet
 Set maFeuille = ActiveSheet
 maColonne = 4  ' numéro de colonne a ajuster, ici c'est 1
derLi = Columns(maColonne).Find("*", , , , , xlPrevious).Row 'derniere ligne, derli = 13 par ex'
 For i = 2 To derLi ' 2 si ligne de titre
 'Si la feuille existe déjà, on passe à la ligne suivante
 If FeuilleExiste(maFeuille.Cells(i, maColonne)) Then GoTo Suivant
 ' ajout d'une feuille à la fin
 Sheets.Add after:=Sheets(Worksheets.Count)
 ' nom de la feuille = valeur de la cellule
 Sheets(Worksheets.Count).Name = maFeuille.Cells(i, maColonne)
Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
 
Sheets(Worksheets.Count).Activate ' feuille de destination
Col = "D"                 ' colonne données non vides à tester'
  NumLig = 0          'Numero de la 1ere ligne de collage '
  With Sheets("feuil1")     ' feuille source'
  NbrLig = .Cells(65536, Col).End(xlUp).Row 'Nombre de ligne
  For Lig = 2 To NbrLig             'n° de la 1ere ligne de données à partir de laquelle on commence jusqu'à NbrLig'
    If .Cells(Lig, Col).Value = "maFeuille.Cells(i, maColonne)" Then
      .Cells(Lig, Col).EntireRow.Copy
      NumLig = NumLig + 1
      Sheets(Worksheets.Count).Cells(NumLig, 1).Insert Shift:=xlDown
            'ici pour insérer ou  .Paste pour coller'
    End If
  Next
  End With

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
 
 Next
 'on retourne à la feuille d'origine
 maFeuille.Select
 Set maFeuille = Nothing
End Sub
 Function FeuilleExiste(Nom$) As Boolean 'Ti
 On Error Resume Next
 FeuilleExiste = Sheets(Nom).Name <> ""
 End Function
 Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column = maColonne Then AjoutFeuilles
 End Sub

Et là grosse cata : " Erreur d'execution '91' : Variable objet ou variable de bloc With non définie "

Merci à celui ou celle qui pourra m'aider, je suis nouvelle en VBA et je ne comprends pas du tous d'où vient l'erreur :'(

05/08/2015, 17h07
camarchepas

Bonjour, récemment j'ai fais se fichier (Consolider.xlsm) pour un cas sensiblement similaire http://www.developpez.net/forums/d15...r-onglet-date/
Si le principe convient je peux éventuellement l'adapter à votre fichier sous réserve de l'avoir entre les mains

Bonjour,

si j'ai bien compris, il faut :

- récupérer une liste sans doublon des valeur de la colonne MaColonne située dans la feuille "feuil1"

- pour chacune de ces valeurs :
* créer une feuille portant le nom "valeur" (si la feuille existe, on nettoie la feuille simplement)
* exporter toutes les lignes contenant "valeur" dans la colonne MaColonne

Je te propose une autre piste, d'autant plus rapide (par rapport à ta méthode) que ta BDD est grosse

j'ai testé sur une de mes BDD (200 000 lignes avec 142 "valeurs" différentes) sans problème et en 20 secondes : j'ai mes 142 feuilles avec leurs données

A noter que j'utilise les filtres automatiques pour écrire moins de lignes de codes ... mais un filtre avancé aurait fait aussi bien l'affaire (et peut être un poil plus rapide, 1 seconde peut être)

Code:

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
Option Compare Text
 
Function SansDoublon(Sh As Worksheet, ColonneAExtraire As Long)
' Génère une liste sans doublon des valeurs d'une colonne
' Débute en ligne 2 et s'arrête à la première ligne vide
Dim Liste, i As Long, Table()
Set Liste = CreateObject("Scripting.dictionary")
 
With Sh.Cells(2, ColonneAExtraire)
    ' on met toute la colonne dans un tableau
    Table = .Resize(.End(xlDown).Row - 1, 1).Value
 
    ' on analyse chaque valeur
    For i = LBound(Table, 1) To UBound(Table, 1)
        ' si elle n'existe pas dans le dictionnaire, on l'ajoute
        If Not Liste.exists(Table(i, 1)) Then Liste.Add Table(i, 1), Table(i, 1)
    Next i
End With
 
' si on a au moins un résultat
If Liste.Count > 0 Then
    ' on renvoie un tableau contenant les valeurs sans doublon
    SansDoublon = Application.Transpose(Liste.keys)
End If
 
End Function
 
Sub test()
Dim Tableau()
Dim ShSource As Worksheet
Dim MaColonne As Long
 
Set ShSource = ThisWorkbook.Worksheets("feuil1")
MaColonne = 4
 
' on récupère la liste sans doublon des "valeurs"
Tableau = SansDoublon(ShSource, MaColonne)
 
Application.ScreenUpdating = False
 
' pour chaque valeur
For i = LBound(Tableau, 1) To UBound(Tableau, 1)
 
    ' on neutralise les erreurs
    On Error Resume Next
    ' on affecte la feuille à une variable + on nettoie la feuille
    Set Sh = Worksheets(Tableau(i, 1)): Sh.UsedRange.Delete
 
    ' si on a une erreur, ça veut dire que la feuille n'existe pas
    If Err.Number <> 0 Then
        ' on crée la feuille et la renomme
        Set Sh = Worksheets.Add
        Sh.Name = Tableau(i, 1)
        Err.Clear
    End If
 
    ' ici, on va utiliser le filtre automatique pour exporter les données dans chaque feuille
    With ShSource
        ' désactive les filtres auto
        .AutoFilterMode = False
        ' filtre sur MaColonne pour avec "valeur" comme critère
        .Range("A1").AutoFilter MaColonne, Tableau(i, 1)
        ' on copie le résultat du filtre auto dans la feuille de "Valeurs"
        ShSource.UsedRange.SpecialCells(xlCellTypeVisible).Copy Sh.Range("A1")
    End With
Next i
' on enlève les filtres
ShSource.AutoFilterMode = False
 
Application.ScreenUpdating = True
 
End Sub

tiens nous au courant

05/08/2015, 18h24
Youdi

Joe.Levrai, merci énormement pour votre code, c'est exactement ce que je cherchais à faire, je ne pouvais espérer mieux!!!

Encore merci :D
05/08/2015, 19h48
joe.levrai

Re bonjour,

j'ai oublié une ligne de code

à placer à la ligne 56

Code:

On Error Goto 0
05/08/2015, 19h57
camarchepas

Politesse et respect = 0 pour les deux.

J'ai testé le même code sur un autre tableau mais ca ne marche plus, j'ai pourtant fais les modifications correspondantes, si quelqu'un peut y jeter un coup d'œil :)
Dans le tableau, la colonne qui m'intéresse pour la création de page est la colonne F "Stream".
Meci d'avance!

Voilà le code utilisé :

Code:

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
Option Compare Text
 
Function SansDoublon(Sh As Worksheet, ColonneAExtraire As Long)
' Génère une liste sans doublon des valeurs d'une colonne
' Débute en ligne 2 et s'arrête à la première ligne vide
Dim Liste, i As Long, Table()
Set Liste = CreateObject("Scripting.dictionary")
 
With Sh.Cells(4, ColonneAExtraire)
    ' on met toute la colonne dans un tableau
    Table = .Resize(.End(xlDown).Row - 1, 1).Value
 
    ' on analyse chaque valeur
    For i = LBound(Table, 1) To UBound(Table, 1)
        ' si elle n'existe pas dans le dictionnaire, on l'ajoute
        If Not Liste.exists(Table(i, 1)) Then Liste.Add Table(i, 1), Table(i, 1)
    Next i
End With
 
' si on a au moins un résultat
If Liste.Count > 0 Then
    ' on renvoie un tableau contenant les valeurs sans doublon
    SansDoublon = Application.Transpose(Liste.keys)
End If
 
End Function
 
Sub test()
Dim Tableau()
Dim ShSource As Worksheet
Dim MaColonne As Long
 
Set ShSource = ThisWorkbook.Worksheets("feuil1")
MaColonne = 6
 
' on récupère la liste sans doublon des "valeurs"
Tableau = SansDoublon(ShSource, MaColonne)
 
Application.ScreenUpdating = False
 
' pour chaque valeur
For i = LBound(Tableau, 1) To UBound(Tableau, 1)
 
    ' on neutralise les erreurs
    On Error Resume Next
    ' on affecte la feuille à une variable + on nettoie la feuille
    Set Sh = Worksheets(Tableau(i, 1)): Sh.UsedRange.Delete
 
    ' si on a une erreur, ça veut dire que la feuille n'existe pas
    If Err.Number <> 0 Then
        ' on crée la feuille et la renomme
        Set Sh = Worksheets.Add
        Sh.Name = Tableau(i, 1)
        Err.Clear
    End If
    On Error GoTo 0
 
    ' ici, on va utiliser le filtre automatique pour exporter les données dans chaque feuille
    With ShSource
        ' désactive les filtres auto
        .AutoFilterMode = False
        ' filtre sur MaColonne pour avec "valeur" comme critère
        .Range("A1").AutoFilter MaColonne, Tableau(i, 1)
        ' on copie le résultat du filtre auto dans la feuille de "Valeurs"
        ShSource.UsedRange.SpecialCells(xlCellTypeVisible).Copy Sh.Range("A1")
    End With
Next i
' on enlève les filtres
ShSource.AutoFilterMode = False
 
Application.ScreenUpdating = True
 
End Sub

06/08/2015, 14h06
joe.levrai

Bonjour,

le problème provient de la structure de ton classeur :

- tes données commencent en ligne 4 ... le filtre doit donc être positionné en ligne 3
- la colonne A n'étant pas utilisé, on ne doit pas introduire l'autofilter via cette colonne
- MaColonne doit être diminué de 1 dans les paramètres de l'autofilter

regarde si tu t'en sors avec ces indications, j'ai peur de ne pas avoir le temps de me pencher sur ça avant deux jours
06/08/2015, 17h31
Youdi

Ca ne marche toujours pas, j'ai changé les numéros comme tu me l'as indiqué, du moins comme je l'ai compris haha mais toujour la meme erreur d'execution '1004' :/
06/08/2015, 21h06
SfJ5Rpw8

Citation:

Envoyé par Youdi

Ca ne marche toujours pas, j'ai changé les numéros comme tu me l'as indiqué, du moins comme je l'ai compris haha mais toujour la meme erreur d'execution '1004' :/

bonjour,

sur qu'elle ligne l'erreur ?
07/08/2015, 10h04
Youdi

Si seulement je pouvais le savoir, je n'ai qu'un simple message box avec "Erreur d'execution '1004'" :/
07/08/2015, 10h15
SfJ5Rpw8

Bonjour,

tu est sur de cela ? un seul bouton "OK" sur ton message box ?
07/08/2015, 10h22
Youdi

Un bouton ok et un bouton aide inutile
07/08/2015, 11h07
bboy-eazy

Il n'y a pas de bouton debogage?
07/08/2015, 11h08
Youdi

Nop il ne me le propose pas

Bonjour,

je ne vois plus ton classeur exemple qui était présent hier

j'ai donc dû travailler en aveugle, et te propose une version généralisée de la procédure

tu dois indiquer 4 choses :

- colonne de recherche
- première colonne de ta plage (dans ton fichier d'hier, c'était 2, colonne B)
- ligne des titres de ta plage (ligne 4 dans ton fichier d'hier)
- le nom de la feuille contenant ta plage

normalement le reste se gère tout seul

dis nous

Code:

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
Option Compare Text
 
Function SansDoublon(Sh As Worksheet, ColonneAExtraire As Long, LigDebut As Long)
' Génère une liste sans doublon des valeurs d'une colonne
' Débute en ligne 2 et s'arrête à la première ligne vide
Dim Liste, i As Long, Table()
Set Liste = CreateObject("Scripting.dictionary")
 
With Sh.Cells(LigDebut + 1, ColonneAExtraire)
    ' on met toute la colonne dans un tableau
    Table = .Resize(.End(xlDown).Row - LigDebut, 1).Value
 
    ' on analyse chaque valeur
    For i = LBound(Table, 1) To UBound(Table, 1)
        ' si elle n'existe pas dans le dictionnaire, on l'ajoute
        If Not Liste.exists(Table(i, 1)) Then Liste.Add Table(i, 1), Table(i, 1)
    Next i
End With
 
' si on a au moins un résultat
If Liste.Count > 0 Then
    ' on renvoie un tableau contenant les valeurs sans doublon
    SansDoublon = Application.Transpose(Liste.keys)
End If
 
End Function
 
Sub test()
Dim Tableau()
Dim ShSource As Worksheet
Dim MaColonne As Long
Dim PremLigne As Long
Dim PremCol As Long
 
Set ShSource = ThisWorkbook.Worksheets("feuil1")
MaColonne = 6 ' la colonne de recherche
PremLigne = 4 ' ligne de titre de la plage
PremCol = 2   ' première colonne de la plage
 
' on récupère la liste sans doublon des "valeurs"
Tableau = SansDoublon(ShSource, MaColonne, PremLigne)
 
Application.ScreenUpdating = False
 
' pour chaque valeur
For i = LBound(Tableau, 1) To UBound(Tableau, 1)
 
    ' on neutralise les erreurs
    On Error Resume Next
    ' on affecte la feuille à une variable + on nettoie la feuille
    Set Sh = Worksheets(Tableau(i, 1)): Sh.UsedRange.Delete
 
    ' si on a une erreur, ça veut dire que la feuille n'existe pas
    If Err.Number <> 0 Then
        ' on crée la feuille et la renomme
        Set Sh = Worksheets.Add
        Sh.Name = Tableau(i, 1)
        Err.Clear
    End If
    On Error GoTo 0
 
    ' ici, on va utiliser le filtre automatique pour exporter les données dans chaque feuille
    With ShSource
        ' désactive les filtres auto
        .AutoFilterMode = False
 
        ' filtre sur MaColonne pour avec "valeur" comme critère
        .Cells(PremLigne, PremCol).AutoFilter MaColonne - PremCol + 1, Tableau(i, 1)
 
        ' si les données ne commencent pas en ligne 1, on masque les lignes parasites
        If PremLigne > 1 Then .Range(.Cells(1, 1), .Cells(PremLigne - 1, 1)).EntireRow.Hidden = True
 
        ' on copie le résultat du filtre auto dans la feuille de "Valeurs"
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sh.Range("A1")
 
        ' on réaffiche les lignes parasites
        If PremLigne > 1 Then .Range(.Cells(1, 1), .Cells(PremLigne - 1, 1)).EntireRow.Hidden = False
    End With
Next i
 
' on enlève les filtres
ShSource.AutoFilterMode = False
 
Application.ScreenUpdating = True
 
End Sub

07/08/2015, 16h59
Youdi

Top ca marche nickel, juste je ne sais pas si c'est normal mais je dois exécuter deux fois de suite la macro pour obtenir le résultat attendu : lorsque j'exécute qu'une seule fois, j'ai bien toutes les pages qui se créent mais je n'ai que la dernière page créée où les lignes du tableau sont transmises, les autres pages sont vides (du moins elles le sont avant la deuxième exécution de la macro!).
J'ai testé sur différents tableaux avec des positions et valeurs différentes et à chaque fois j'ai besoins d'exécuter deux fois la macro!

Mais merci pour le code en tout cas, le résultat est là et c'est ce qui compte :)

J'ai reconstitué une petite BDD pour tester le code

mes pages se remplissent correctement ... par contre j'ai eu la chance de trouver une petite faille que j'ai corrigé
actuellement, si le nom de tes "valeurs" ne respectaient pas la norme pour un nom d'onglet, le message d'erreur était neutralisé.

là au moins tu auras un message d'erreur

Code:

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
Option Compare Text
 
Function SansDoublon(Sh As Worksheet, ColonneAExtraire As Long, LigDebut As Long)
' Génère une liste sans doublon des valeurs d'une colonne
' Débute en ligne 2 et s'arrête à la première ligne vide
Dim Liste, i As Long, Table()
Set Liste = CreateObject("Scripting.dictionary")
 
With Sh.Cells(LigDebut + 1, ColonneAExtraire)
    ' on met toute la colonne dans un tableau
    Table = .Resize(.End(xlDown).Row - LigDebut, 1).Value
 
    ' on analyse chaque valeur
    For i = LBound(Table, 1) To UBound(Table, 1)
        ' si elle n'existe pas dans le dictionnaire, on l'ajoute
        If Not Liste.exists(Table(i, 1)) Then Liste.Add Table(i, 1), Table(i, 1)
    Next i
End With
 
' si on a au moins un résultat
If Liste.Count > 0 Then
    ' on renvoie un tableau contenant les valeurs sans doublon
    SansDoublon = Application.Transpose(Liste.keys)
End If
 
End Function
 
Sub test()
Dim Tableau()
Dim ShSource As Worksheet
Dim Sh As Worksheet
Dim MaColonne As Long
Dim PremLigne As Long
Dim PremCol As Long
 
Set ShSource = ThisWorkbook.Worksheets("Recensement_Boites_Mail")
MaColonne = 4 ' la colonne de recherche
PremLigne = 1 ' ligne de titre de la plage
PremCol = 1   ' première colonne de la plage
 
' on récupère la liste sans doublon des "valeurs"
Tableau = SansDoublon(ShSource, MaColonne, PremLigne)
 
Application.ScreenUpdating = False
 
' pour chaque valeur
For i = LBound(Tableau, 1) To UBound(Tableau, 1)
 
    Set Sh = Nothing
 
    ' on neutralise les erreurs
    On Error Resume Next
    ' on affecte la feuille à une variable + on nettoie la feuille
    Set Sh = Worksheets(Tableau(i, 1)): Sh.UsedRange.Delete
    On Error GoTo 0
 
    If Sh Is Nothing Then
        ' on crée la feuille et la renomme
        Set Sh = Worksheets.Add
        Sh.Name = Tableau(i, 1)
    End If
 
    ' ici, on va utiliser le filtre automatique pour exporter les données dans chaque feuille
    With ShSource
        ' désactive les filtres auto
        .AutoFilterMode = False
 
        ' filtre sur MaColonne pour avec "valeur" comme critère
        .Cells(PremLigne, PremCol).AutoFilter MaColonne - PremCol + 1, Tableau(i, 1)
 
        ' si les données ne commencent pas en ligne 1, on masque les lignes parasites
        If PremLigne > 1 Then .Range(.Cells(1, 1), .Cells(PremLigne - 1, 1)).EntireRow.Hidden = True
 
        ' on copie le résultat du filtre auto dans la feuille de "Valeurs"
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sh.Range("A1")
 
        ' on réaffiche les lignes parasites
        If PremLigne > 1 Then .Range(.Cells(1, 1), .Cells(PremLigne - 1, 1)).EntireRow.Hidden = False
    End With
Next i
 
' on enlève les filtres
ShSource.AutoFilterMode = False
 
Application.ScreenUpdating = True
 
End Sub

Si ton problème lors du premier lancement persiste, peux-tu joindre une fichier exemple où le problème se rencontre ?

07/08/2015, 17h20
Youdi

Je viens d'adapter ton dernier code à mon tableau, le problème d'exécution est réglé, je ne sais pas si c'est normal, mais tant mieux :)
Tous fonctionne comme sur des roulettes!
Encore merci!