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
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
Daniel
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
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
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
- 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
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
Merci Daniel de ta réponse. En effet, c'est beaucoup mieux. 1-Est-il possible de recopier le titre (ligne 1 à 8) en respectant la mise en forme ? Dans la macro, j'ai modifié A9 par A8 car il me recopiait systématiquement le 1er enregistrement du tableau général sur chaque tableau généré. Ai-je bien fait ? 2-Est-il possible de masquer l'onglet "affectation" sur tous les tableaux générés ?
Encore merci de ton efficace et précieuse aide !! -- MCA
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
Merci Daniel de ta réponse.
En effet, c'est beaucoup mieux.
1-Est-il possible de recopier le titre (ligne 1 à 8) en respectant la mise
en forme ?
Dans la macro, j'ai modifié A9 par A8 car il me recopiait systématiquement
le 1er enregistrement du tableau général sur chaque tableau généré. Ai-je
bien fait ?
2-Est-il possible de masquer l'onglet "affectation" sur tous les tableaux
générés ?
Encore merci de ton efficace et précieuse aide !!
--
MCA
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
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
- 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
Merci Daniel de ta réponse. En effet, c'est beaucoup mieux. 1-Est-il possible de recopier le titre (ligne 1 à 8) en respectant la mise en forme ? Dans la macro, j'ai modifié A9 par A8 car il me recopiait systématiquement le 1er enregistrement du tableau général sur chaque tableau généré. Ai-je bien fait ? 2-Est-il possible de masquer l'onglet "affectation" sur tous les tableaux générés ?
Encore merci de ton efficace et précieuse aide !! -- MCA
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