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

Le
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:¬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" <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:¬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" <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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel
Le #4330631
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"
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"
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"
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








MCA
Le #4330131
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"
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"
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"
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













Publicité
Poster une réponse
Anonyme