macro visual basic dans excel (suite)

Le
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


> "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
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 #4237171
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
Le #4237101
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"
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











Publicité
Poster une réponse
Anonyme