Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel URGENT : macro visual basic dans excel (suite, suite)

URGENT : macro visual basic dans excel (suite, suite)

2 réponses
Avatar
MCA
Daniel,
J'ai généré mes fichiers sans problème. Sauf que pour ma dernière liste
déroulante (qui fait appel à une autre feuille), lorsque je clique dessus, la
liste ne se déroule pas. Il faut obligatoirement que j'ouvre mon gros fichier
initial pour qu'elle s'affiche normalement. Pourquoi ??? Il n'y a que cela
qui me bloque.
Merci de ta réponse

"Daniel" a écrit :

> Bonjour.
> Au temps pour moi. Essaie :
>
> Sub DécouperGRH()
>
> Dim Rg As Range, A As Integer
> Dim Wk As Workbook, Rg1 As Range
> Dim Sh As Worksheet, Chemin As String
>
> 'Chemin où tu veux enregistrer chacun des fichiers
> Chemin = "D:\Mes documents\"
>
> 'Nom du classeur (racine du nom)
> 'à ceci s'ajoute un numéro dans la procédure
> nom = "ENQUETE"
>
> 'Où sont les données
> 'Nom feuille à déterminer
> Worksheets("Tableau final").Copy Before:=Sheets(1)
>
> Set Sh = ActiveWorkbook.ActiveSheet
> 'Ici tu modifies la lettre N pour
> 'la lettre de la colonne que tu désires.
> With Sh
> Set Rg = .Range("A9:P" & .Range("A65536").End(xlUp).Row)
> End With
>
> Application.ScreenUpdating = False
> 'Ajout d'un classer
> ThisWorkbook.Sheets("affectation").Copy
> ThisWorkbook.Sheets("Tableau final").Copy Before:=ActiveWorkbook.Sheets(1)
> Range("A9:P" & Range("A65536").End(xlUp).Row).ClearContents
> Set Wk = ActiveWorkbook
> Application.EnableEvents = False
> Do
> With Rg
> 'trier par ordre croissant
> .Sort Key1:=Rg(2, 1), Header:=xlYes
> 'Filtre automatique
> .AutoFilter Field:=1, Criteria1:=Rg(2, 1)
> Set Rg1 = Sh.Range("_FilterDataBase")
> .SpecialCells (xlCellTypeVisible)
> 'Copie du résultat du filtre vers nouveau classeur
> Rg1.Copy
> Wk.Sheets(1).Range("A9").PasteSpecial xlValues
> Rg1.Offset(1).Clear
> A = A + 1
> 'Sauvegarde du classeur
> Wk.SaveAs Chemin & nom & A & ".xls"
> Wk.Sheets(1).Range("A9:P" &
> Range("A65536").End(xlUp).Row).ClearContents
> .AutoFilter
> .Sort Key1:=Rg(2, 1), Header:=xlYes
> End With
> Loop Until Rg(2, 1) = ""
> Application.EnableEvents = True
> Application.DisplayAlerts = False
> Sh.Delete
> Application.DisplayAlerts = True
> Wk.Close False
> Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
> End Sub
>
> Cordialement.
> Daniel
> "MCA" <MCA@discussions.microsoft.com> a écrit dans le message de news:
> 32682326-447B-48B0-9302-17E476E88746@microsoft.com...
> > Bonjour,
> > J'ai fait ce que Daniel m'avait dit. Seulement, lors de la copie des
> > fichiers, les données (liste déroulante) ne se copient pas. Il n'y a que
> > le
> > 1er fichier généré qui est correct. Les autres sont incomplets, si on
> > clique
> > sur les cellules où il devrait une liste déroulante, il n'y a rien !!
> > Merci de m'éclairer.
> > MCA
> >> Merci beaucoup Daniel, c'est exactement ce que je voulais.
> >> Bon week-end
> >> --
> >> MCA
> >
> >
> >> "Daniel" a écrit :
> >
> >> Mets la macro dans un module du classeur enquete.xls :
> >>
> >> Sub DécouperGRH()
> >>
> >> Dim Rg As Range, A As Integer
> >> Dim Wk As Workbook, Rg1 As Range
> >> Dim Sh As Worksheet, Chemin As String
> >>
> >> 'Chemin où tu veux enregistrer chacun des fichiers
> >> Chemin = "D:\Mes documents\"
> >>
> >> 'Nom du classeur (racine du nom)
> >> 'à ceci s'ajoute un numéro dans la procédure
> >> nom = "ENQUETE"
> >>
> >> 'Où sont les données
> >> 'Nom feuille à déterminer
> >> Worksheets("Tableau final").Copy Before:=Sheets(1)
> >>
> >> Set Sh = ActiveWorkbook.ActiveSheet
> >> 'Ici tu modifies la lettre N pour
> >> 'la lettre de la colonne que tu désires.
> >> With Sh
> >> Set Rg = .Range("A9:P" & .Range("A65536").End(xlUp).Row)
> >> End With
> >>
> >> Application.ScreenUpdating = False
> >> 'Ajout d'un classer
> >> ThisWorkbook.Sheets("affectation").Copy
> >> ThisWorkbook.Sheets("Tableau final").Copy
> >> Before:=ActiveWorkbook.Sheets(1)
> >> Range("A9:P" & Range("A65536").End(xlUp).Row).ClearContents
> >> Set Wk = ActiveWorkbook
> >> Application.EnableEvents = False
> >> Do
> >> With Rg
> >> 'trier par ordre croissant
> >> .Sort Key1:=Rg(2, 1), Header:=xlYes
> >> 'Filtre automatique
> >> .AutoFilter Field:=1, Criteria1:=Rg(2, 1)
> >> Set Rg1 = Sh.Range("_FilterDataBase")
> >> .SpecialCells (xlCellTypeVisible)
> >> 'Copie du résultat du filtre vers nouveau classeur
> >> Rg1.Copy Wk.Sheets(1).Range("A9")
> >> Rg1.Offset(1).Clear
> >> A = A + 1
> >> 'Sauvegarde du classeur
> >> Wk.SaveAs Chemin & nom & A & ".xls"
> >> Wk.Sheets(1).Range("A9:P" &
> >> Range("A65536").End(xlUp).Row).ClearContents
> >> .AutoFilter
> >> .Sort Key1:=Rg(2, 1), Header:=xlYes
> >> End With
> >> Loop Until Rg(2, 1) = ""
> >> Application.EnableEvents = True
> >> Application.DisplayAlerts = False
> >> Sh.Delete
> >> Application.DisplayAlerts = True
> >> Wk.Close False
> >> Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
> >> End Sub
> >>
> >> Cordialement.
> >> Daniel
> >> "MCA" <MCA@discussions.microsoft.com> a écrit dans le message de news:
> >> A8F29840-1617-4CC3-9692-1587C3973F41@microsoft.com...
> >> > Merci Daniel de ta réponse.
> >> > Ci-dessous le lien pour accéder au fichier :
> >> > http://cjoint.com/?djojJg2G3q
> >> >
> >> > Précisions :
> >> > -Dans chaque fichier, je veux copier le titre qui va de la ligne 1 à 8
> >> > -j'ai des listes déroulantes dans les colonnes F, L, O (pour cette
> >> > dernière
> >> > colonne, le détail de ma liste déroulante se trouve dans la feuille
> >> > appelée
> >> > "affectation" que je masque par la suite.
> >> > -les feuilles à récupérer dans chaque fichier sont "tableau final" et
> >> > "affectation".
> >> >
> >> > Je ne sais pas si mes explications sont suffisamment claires pour
> >> > t'apporter
> >> > les éclaircissements attendus.
> >> >
> >> >
> >> > --
> >> > MCA
> >> >
> >> >
> >> > "Daniel" a écrit :
> >> >
> >> >> > - j'ai des colonnes avec des listes déroulantes (données/validation)
> >> >> > - et j'ai deux feuilles.
> >> >>
> >> >> Bonjour.
> >> >> Quelques précisions.
> >> >> Les classeurs cibles doivent récupérer les listes de validation, et,
> >> >> dans
> >> >> ce
> >> >> cas, comment sont-elles définies et à quelles plages
> >> >> s'appliquent-elles ?
> >> >> Tu veux également récupérer deux feuilles dans les classeurs cible ?,
> >> >> les
> >> >> données des deux feuilles ont-elles la même structure ?
> >> >> Si possible, dépose un classeur exemple (en effaçant les données
> >> >> confidentielles) et en diminuant la masse de données afin que le
> >> >> classeur
> >> >> ne
> >> >> soit pas trop gros sur le site :
> >> >> www.cjoint.com et poste l'adresse générée.
> >> >> Cordialement.
> >> >> Daniel
> >
> >
> > --
> > MCA
>
>
>
--
MCA
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Daniel
Je n'ai vérifié que sur le premier fichier :

Sub DécouperGRH()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "D:Mes documents"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "ENQUETE"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Tableau final").Copy Before:=Sheets(1)

Set Sh = ActiveWorkbook.ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A9:P" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
ThisWorkbook.Sheets("affectation").Copy
ThisWorkbook.Sheets("Tableau final").Copy Before:¬tiveWorkbook.Sheets(1)
Sheets("affectation").Range("A1:A42").Name = "affectation"
Range("A9:P" & Range("A65536").End(xlUp).Row).ClearContents
Set Wk = ActiveWorkbook
Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy
Wk.Sheets(1).Range("A9").PasteSpecial xlValues
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Range("A9:P" &
Range("A65536").End(xlUp).Row).ClearContents
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub

Daniel
"MCA" a écrit dans le message de news:

Daniel,
J'ai généré mes fichiers sans problème. Sauf que pour ma dernière liste
déroulante (qui fait appel à une autre feuille), lorsque je clique dessus,
la
liste ne se déroule pas. Il faut obligatoirement que j'ouvre mon gros
fichier
initial pour qu'elle s'affiche normalement. Pourquoi ??? Il n'y a que cela
qui me bloque.
Merci de ta réponse


Bonjour.
Au temps pour moi. Essaie :

Sub DécouperGRH()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "D:Mes documents"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "ENQUETE"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Tableau final").Copy Before:=Sheets(1)

Set Sh = ActiveWorkbook.ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A9:P" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
ThisWorkbook.Sheets("affectation").Copy
ThisWorkbook.Sheets("Tableau final").Copy
Before:¬tiveWorkbook.Sheets(1)
Range("A9:P" & Range("A65536").End(xlUp).Row).ClearContents
Set Wk = ActiveWorkbook
Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy
Wk.Sheets(1).Range("A9").PasteSpecial xlValues
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Range("A9:P" &
Range("A65536").End(xlUp).Row).ClearContents
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub

Cordialement.
Daniel
"MCA" a écrit dans le message de news:

Bonjour,
J'ai fait ce que Daniel m'avait dit. Seulement, lors de la copie des
fichiers, les données (liste déroulante) ne se copient pas. Il n'y a
que
le
1er fichier généré qui est correct. Les autres sont incomplets, si on
clique
sur les cellules où il devrait une liste déroulante, il n'y a rien !!
Merci de m'éclairer.
MCA
Merci beaucoup Daniel, c'est exactement ce que je voulais.
Bon week-end
--
MCA




Mets la macro dans un module du classeur enquete.xls :

Sub DécouperGRH()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "D:Mes documents"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "ENQUETE"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Tableau final").Copy Before:=Sheets(1)

Set Sh = ActiveWorkbook.ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A9:P" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
ThisWorkbook.Sheets("affectation").Copy
ThisWorkbook.Sheets("Tableau final").Copy
Before:¬tiveWorkbook.Sheets(1)
Range("A9:P" & Range("A65536").End(xlUp).Row).ClearContents
Set Wk = ActiveWorkbook
Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A9")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Range("A9:P" &
Range("A65536").End(xlUp).Row).ClearContents
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub

Cordialement.
Daniel
"MCA" a écrit dans le message de news:

Merci Daniel de ta réponse.
Ci-dessous le lien pour accéder au fichier :
http://cjoint.com/?djojJg2G3q

Précisions :
-Dans chaque fichier, je veux copier le titre qui va de la ligne 1 à
8
-j'ai des listes déroulantes dans les colonnes F, L, O (pour cette
dernière
colonne, le détail de ma liste déroulante se trouve dans la feuille
appelée
"affectation" que je masque par la suite.
-les feuilles à récupérer dans chaque fichier sont "tableau final"
et
"affectation".

Je ne sais pas si mes explications sont suffisamment claires pour
t'apporter
les éclaircissements attendus.


--
MCA



- j'ai des colonnes avec des listes déroulantes
(données/validation)
- et j'ai deux feuilles.


Bonjour.
Quelques précisions.
Les classeurs cibles doivent récupérer les listes de validation,
et,
dans
ce
cas, comment sont-elles définies et à quelles plages
s'appliquent-elles ?
Tu veux également récupérer deux feuilles dans les classeurs cible
?,
les
données des deux feuilles ont-elles la même structure ?
Si possible, dépose un classeur exemple (en effaçant les données
confidentielles) et en diminuant la masse de données afin que le
classeur
ne
soit pas trop gros sur le site :
www.cjoint.com et poste l'adresse générée.
Cordialement.
Daniel





--
MCA




--

MCA








Avatar
MCA
Merci beaucoup Daniel. C'est parfait !!
Il va vraiment falloir que je m'y mette car c'est fou ce que l'on peut faire
...
Merci encore
--
MCA



Je n'ai vérifié que sur le premier fichier :

Sub DécouperGRH()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "D:Mes documents"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "ENQUETE"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Tableau final").Copy Before:=Sheets(1)

Set Sh = ActiveWorkbook.ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A9:P" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
ThisWorkbook.Sheets("affectation").Copy
ThisWorkbook.Sheets("Tableau final").Copy Before:¬tiveWorkbook.Sheets(1)
Sheets("affectation").Range("A1:A42").Name = "affectation"
Range("A9:P" & Range("A65536").End(xlUp).Row).ClearContents
Set Wk = ActiveWorkbook
Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy
Wk.Sheets(1).Range("A9").PasteSpecial xlValues
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Range("A9:P" &
Range("A65536").End(xlUp).Row).ClearContents
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub

Daniel
"MCA" a écrit dans le message de news:

Daniel,
J'ai généré mes fichiers sans problème. Sauf que pour ma dernière liste
déroulante (qui fait appel à une autre feuille), lorsque je clique dessus,
la
liste ne se déroule pas. Il faut obligatoirement que j'ouvre mon gros
fichier
initial pour qu'elle s'affiche normalement. Pourquoi ??? Il n'y a que cela
qui me bloque.
Merci de ta réponse


Bonjour.
Au temps pour moi. Essaie :

Sub DécouperGRH()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "D:Mes documents"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "ENQUETE"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Tableau final").Copy Before:=Sheets(1)

Set Sh = ActiveWorkbook.ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A9:P" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
ThisWorkbook.Sheets("affectation").Copy
ThisWorkbook.Sheets("Tableau final").Copy
Before:¬tiveWorkbook.Sheets(1)
Range("A9:P" & Range("A65536").End(xlUp).Row).ClearContents
Set Wk = ActiveWorkbook
Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy
Wk.Sheets(1).Range("A9").PasteSpecial xlValues
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Range("A9:P" &
Range("A65536").End(xlUp).Row).ClearContents
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub

Cordialement.
Daniel
"MCA" a écrit dans le message de news:

Bonjour,
J'ai fait ce que Daniel m'avait dit. Seulement, lors de la copie des
fichiers, les données (liste déroulante) ne se copient pas. Il n'y a
que
le
1er fichier généré qui est correct. Les autres sont incomplets, si on
clique
sur les cellules où il devrait une liste déroulante, il n'y a rien !!
Merci de m'éclairer.
MCA
Merci beaucoup Daniel, c'est exactement ce que je voulais.
Bon week-end
--
MCA




Mets la macro dans un module du classeur enquete.xls :

Sub DécouperGRH()

Dim Rg As Range, A As Integer
Dim Wk As Workbook, Rg1 As Range
Dim Sh As Worksheet, Chemin As String

'Chemin où tu veux enregistrer chacun des fichiers
Chemin = "D:Mes documents"

'Nom du classeur (racine du nom)
'à ceci s'ajoute un numéro dans la procédure
nom = "ENQUETE"

'Où sont les données
'Nom feuille à déterminer
Worksheets("Tableau final").Copy Before:=Sheets(1)

Set Sh = ActiveWorkbook.ActiveSheet
'Ici tu modifies la lettre N pour
'la lettre de la colonne que tu désires.
With Sh
Set Rg = .Range("A9:P" & .Range("A65536").End(xlUp).Row)
End With

Application.ScreenUpdating = False
'Ajout d'un classer
ThisWorkbook.Sheets("affectation").Copy
ThisWorkbook.Sheets("Tableau final").Copy
Before:¬tiveWorkbook.Sheets(1)
Range("A9:P" & Range("A65536").End(xlUp).Row).ClearContents
Set Wk = ActiveWorkbook
Application.EnableEvents = False
Do
With Rg
'trier par ordre croissant
.Sort Key1:=Rg(2, 1), Header:=xlYes
'Filtre automatique
.AutoFilter Field:=1, Criteria1:=Rg(2, 1)
Set Rg1 = Sh.Range("_FilterDataBase")
.SpecialCells (xlCellTypeVisible)
'Copie du résultat du filtre vers nouveau classeur
Rg1.Copy Wk.Sheets(1).Range("A9")
Rg1.Offset(1).Clear
A = A + 1
'Sauvegarde du classeur
Wk.SaveAs Chemin & nom & A & ".xls"
Wk.Sheets(1).Range("A9:P" &
Range("A65536").End(xlUp).Row).ClearContents
.AutoFilter
.Sort Key1:=Rg(2, 1), Header:=xlYes
End With
Loop Until Rg(2, 1) = ""
Application.EnableEvents = True
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
Wk.Close False
Set Wk = Nothing: Set Sh = Nothing: Set Rg1 = Nothing
End Sub

Cordialement.
Daniel
"MCA" a écrit dans le message de news:

Merci Daniel de ta réponse.
Ci-dessous le lien pour accéder au fichier :
http://cjoint.com/?djojJg2G3q

Précisions :
-Dans chaque fichier, je veux copier le titre qui va de la ligne 1 à
8
-j'ai des listes déroulantes dans les colonnes F, L, O (pour cette
dernière
colonne, le détail de ma liste déroulante se trouve dans la feuille
appelée
"affectation" que je masque par la suite.
-les feuilles à récupérer dans chaque fichier sont "tableau final"
et
"affectation".

Je ne sais pas si mes explications sont suffisamment claires pour
t'apporter
les éclaircissements attendus.


--
MCA



- j'ai des colonnes avec des listes déroulantes
(données/validation)
- et j'ai deux feuilles.


Bonjour.
Quelques précisions.
Les classeurs cibles doivent récupérer les listes de validation,
et,
dans
ce
cas, comment sont-elles définies et à quelles plages
s'appliquent-elles ?
Tu veux également récupérer deux feuilles dans les classeurs cible
?,
les
données des deux feuilles ont-elles la même structure ?
Si possible, dépose un classeur exemple (en effaçant les données
confidentielles) et en diminuant la masse de données afin que le
classeur
ne
soit pas trop gros sur le site :
www.cjoint.com et poste l'adresse générée.
Cordialement.
Daniel





--
MCA




--

MCA