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

macro visual basic dans excel (suite)

2 réponses
Avatar
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:=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
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
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






Avatar
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