Discussion :

[Youdi]

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

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

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

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

Suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

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

Suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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

[joe.levrai]

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 :

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

[Youdi]

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

Encore merci

[joe.levrai]

Re bonjour,

j'ai oublié une ligne de code

à placer à la ligne 56

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

On Error Goto 0

[camarchepas]

Politesse et respect = 0 pour les deux.

[Youdi]

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 :

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

[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

[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' :/

[SfJ5Rpw8]

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 ?

[Youdi]

Si seulement je pouvais le savoir, je n'ai qu'un simple message box avec "Erreur d'execution '1004'" :/

[SfJ5Rpw8]

Bonjour,

tu est sur de cela ? un seul bouton "OK" sur ton message box ?

[Youdi]

Un bouton ok et un bouton aide inutile

[bboy-eazy]

Il n'y a pas de bouton debogage?

[Youdi]

Nop il ne me le propose pas

[joe.levrai]

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 :

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

[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

[joe.levrai]

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 :

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

[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!