OVH Cloud OVH Cloud

sélection des en-tête de colonne d'une feuille par macro

5 réponses
Avatar
Orsu
Bonsoir le forum

J'ai une macro (réalisée avec l'aide du forum et notamment de JB) qui me
permet, à partir d'un classeur contenant une BD importante, de créer des
classeurs distincts en fonction d'un regroupement fait à la demande de
l'utilisateur, qui choisit la colonne à partir de laquelle le regroupement
sera fait (le détail de lamacro figure en fin du message).

Pour illustrer avec la base ci-après, si l'utilisateur choisit la colonne A,
la macro crééra 3 classeurs ; s'il choisit la colonne D, 2 classeurs
seulement seront créés,..etc...
ANNEE Origine TYPE Test
2007 25 3 OUI
2006 10 3 OUI
2005 23 3 OUI
2006 10 3 OUI
2005 2 3 OUI
2006 3 3 OUI
2005 10 3 NON
2007 22 3 OUI
2006 25 1 OUI

Toutefois, la macro actuelle utilise une simple inputbox qui demande à
l'utilisateur de saisir manuellement l'intitulé exactde la colonne d'en-tête
; si l'utilisateur n'entre pas exactement cet intitulé, la macro ne
fonctionne pas. Or, certains en-têtes peuvent contenir des espaces, des
caractères bizarres, etc... que l'utilisateur lambda n'appréhende pas
nécessairement...

Pour simplifier le processus, je voudrais (on y arrive enfin!) qu'une liste
déroulante contenant l'ensemble des en-têtes de colonne de la feuille active
(nb variable selon la feuille) soit offerte à l'utilisateur afin qu'il n'ait
qu'à choisir dans la liste proposée pour initier le reste de la
macro........
Par ailleurs, si l'utilisateur ne choisit rien ou clique sur annuler, il
faudrait que la macro s'annule.......

Quelqu'un pourrait-il m'aider à faire évoluer la macro concernée ?

Merci d'avance !!!

Sub CreeClasseursXXX()
Application.DisplayAlerts = False

f = ActiveSheet.Name

pw = InputBox("Inscrire le libellé exact de la colonne source")

If pw <> "" Then

Range("HH1") = pw

Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[hh1], Unique:=True

For Each c In Range("HH2", Range("HH65000").End(xlUp))
Range("HH2") = c
Sheets.Add
Sheets(f).Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets(f).[HH1:HH2], CopyToRange:=[A1], Unique:=False
ActiveSheet.Copy
ActiveWorkbook.SaveAs FileName:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets(f).Select

Next c

ActiveSheet.Range("HH1").CurrentRegion.Select
Selection.Delete
ActiveSheet.Range("A1").Select

Else
MsgBox "Essaie encore...", vbCritical, "Désolé !" 'optionnel
Range("A1").Select

End If

End Sub

5 réponses

Avatar
JB
Bonsoir,

Le choix du critere se fait dans une liste déroulante:

Sub CreeClasseurs()
Application.DisplayAlerts = False
f = ActiveSheet.Name
[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[p1], Unique:=True
For Each c In Range("P2", Range("P65000").End(xlUp))
Range("P2") = c
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(f).[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets(f).[P1:P2], CopyToRange:=[A1],
Unique:úlse
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets(f).Select
Next c
End Sub

http://cjoint.com/?dpubL5mgur

JB


On 15 mar, 19:24, "Orsu" wrote:
Bonsoir le forum

J'ai une macro (réalisée avec l'aide du forum et notamment de JB) qui me
permet, à partir d'un classeur contenant une BD importante, de créer d es
classeurs distincts en fonction d'un regroupement fait à la demande de
l'utilisateur, qui choisit la colonne à partir de laquelle le regroupeme nt
sera fait  (le détail de lamacro figure en fin du message).

Pour illustrer avec la base ci-après, si l'utilisateur choisit la colonn e A,
la macro crééra 3 classeurs ; s'il choisit la colonne D, 2 classeurs
seulement seront créés,..etc...
ANNEE Origine TYPE  Test
2007         25         3     OUI
2006         10         3     OUI
2005         23         3     OUI
2006         10         3     OUI
2005          2          3     OUI
2006          3          3     OUI
2005         10         3     NON
2007         22         3     OUI
2006         25         1     OUI

Toutefois, la macro actuelle utilise une simple inputbox qui demande à
l'utilisateur de saisir manuellement l'intitulé exactde la colonne d'en- tête
; si l'utilisateur n'entre pas exactement cet intitulé, la macro ne
fonctionne pas. Or, certains en-têtes peuvent contenir des espaces, des
caractères bizarres, etc... que l'utilisateur lambda n'appréhende pas
nécessairement...

Pour simplifier le processus, je voudrais (on y arrive enfin!) qu'une list e
déroulante contenant l'ensemble des en-têtes de colonne de la feuille active
(nb variable selon la feuille) soit offerte à l'utilisateur afin qu'il n 'ait
qu'à choisir dans la liste proposée pour initier le reste de la
macro........
Par ailleurs, si l'utilisateur ne choisit rien ou clique sur annuler, il
faudrait que la macro s'annule.......

Quelqu'un pourrait-il m'aider à faire évoluer la macro concernée ?

Merci d'avance !!!

Sub CreeClasseursXXX()
  Application.DisplayAlerts = False

  f = ActiveSheet.Name

  pw = InputBox("Inscrire le libellé exact de la colonne source")

If pw <> "" Then

  Range("HH1") = pw

  Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[hh1], Unique:=True

  For Each c In Range("HH2", Range("HH65000").End(xlUp))
    Range("HH2") = c
    Sheets.Add
    Sheets(f).Range("A1").CurrentRegion.AdvancedFilter Action:=xlFil terCopy,
_
       CriteriaRange:=Sheets(f).[HH1:HH2], CopyToRange:=[A1], Unique:úlse
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs FileName:=c
    ActiveWorkbook.Close
    ActiveSheet.Delete
    Sheets(f).Select

  Next c

    ActiveSheet.Range("HH1").CurrentRegion.Select
    Selection.Delete
    ActiveSheet.Range("A1").Select

  Else
   MsgBox "Essaie encore...", vbCritical, "Désolé !" 'optionnel
   Range("A1").Select

End If

End Sub


Avatar
JB
http://cjoint.com/?dpuqe4cq3H

JB

On 15 mar, 20:01, JB wrote:
Bonsoir,

Le choix du critere se fait dans une liste déroulante:

Sub CreeClasseurs()
  Application.DisplayAlerts = False
  f = ActiveSheet.Name
  [A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[p1], Unique:=True
  For Each c In Range("P2", Range("P65000").End(xlUp))
    Range("P2") = c
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(f).[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy ,
_
       CriteriaRange:=Sheets(f).[P1:P2], CopyToRange:=[A1],
Unique:úlse
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=c
    ActiveWorkbook.Close
    ActiveSheet.Delete
    Sheets(f).Select
  Next c
End Sub

http://cjoint.com/?dpubL5mgur

JB

On 15 mar, 19:24, "Orsu" wrote:



Bonsoir le forum

J'ai une macro (réalisée avec l'aide du forum et notamment de JB) qu i me
permet, à partir d'un classeur contenant une BD importante, de créer des
classeurs distincts en fonction d'un regroupement fait à la demande de
l'utilisateur, qui choisit la colonne à partir de laquelle le regroupe ment
sera fait  (le détail de lamacro figure en fin du message).

Pour illustrer avec la base ci-après, si l'utilisateur choisit la colo nne A,
la macro crééra 3 classeurs ; s'il choisit la colonne D, 2 classeurs
seulement seront créés,..etc...
ANNEE Origine TYPE  Test
2007         25         3     OUI
2006         10         3     OUI
2005         23         3     OUI
2006         10         3     OUI
2005          2          3     OUI
2006          3          3     OUI
2005         10         3     NON
2007         22         3     OUI
2006         25         1     OUI

Toutefois, la macro actuelle utilise une simple inputbox qui demande à
l'utilisateur de saisir manuellement l'intitulé exactde la colonne d'e n-tête
; si l'utilisateur n'entre pas exactement cet intitulé, la macro ne
fonctionne pas. Or, certains en-têtes peuvent contenir des espaces, de s
caractères bizarres, etc... que l'utilisateur lambda n'appréhende pa s
nécessairement...

Pour simplifier le processus, je voudrais (on y arrive enfin!) qu'une li ste
déroulante contenant l'ensemble des en-têtes de colonne de la feuill e active
(nb variable selon la feuille) soit offerte à l'utilisateur afin qu'il n'ait
qu'à choisir dans la liste proposée pour initier le reste de la
macro........
Par ailleurs, si l'utilisateur ne choisit rien ou clique sur annuler, il
faudrait que la macro s'annule.......

Quelqu'un pourrait-il m'aider à faire évoluer la macro concernée ?

Merci d'avance !!!

Sub CreeClasseursXXX()
  Application.DisplayAlerts = False

  f = ActiveSheet.Name

  pw = InputBox("Inscrire le libellé exact de la colonne source")

If pw <> "" Then

  Range("HH1") = pw

  Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[hh1], Unique:=True

  For Each c In Range("HH2", Range("HH65000").End(xlUp))
    Range("HH2") = c
    Sheets.Add
    Sheets(f).Range("A1").CurrentRegion.AdvancedFilter Action:=xlF ilterCopy,
_
       CriteriaRange:=Sheets(f).[HH1:HH2], CopyToRange:=[A1] , Unique:úlse
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs FileName:=c
    ActiveWorkbook.Close
    ActiveSheet.Delete
    Sheets(f).Select

  Next c

    ActiveSheet.Range("HH1").CurrentRegion.Select
    Selection.Delete
    ActiveSheet.Range("A1").Select

  Else
   MsgBox "Essaie encore...", vbCritical, "Désolé !" 'optionnel
   Range("A1").Select

End If

End Sub- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -



Avatar
Orsu
Merci à JB pour sa solution.....mais ce n'est pas exactement ce que je
cherche à faire (je n'ai pas été précis dans ma demande je m'en aperçois
après coup).

En fait, je voudrais qu'il y ait une boite de dialogue offrant à
l'utilisateur une liste déroulante contenant l'ensemble des en-têtes de
colonne de la feuille active (nb variable selon la feuille) afin qu'il n'ait
qu'à choisir dans la liste proposée pour initier le reste de la macro (la
localisation de la liste déroulante dans une cellule peut dans certaines
feuilles poser problème car les BD ont parfois un nb important de
colonnes....)

Merci d'avance pour vos conseils

"JB" a écrit dans le message de news:


http://cjoint.com/?dpuqe4cq3H

JB

On 15 mar, 20:01, JB wrote:
Bonsoir,

Le choix du critere se fait dans une liste déroulante:

Sub CreeClasseurs()
Application.DisplayAlerts = False
f = ActiveSheet.Name
[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[p1], Unique:=True
For Each c In Range("P2", Range("P65000").End(xlUp))
Range("P2") = c
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(f).[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets(f).[P1:P2], CopyToRange:=[A1],
Unique:úlse
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets(f).Select
Next c
End Sub

http://cjoint.com/?dpubL5mgur

JB

On 15 mar, 19:24, "Orsu" wrote:



Bonsoir le forum

J'ai une macro (réalisée avec l'aide du forum et notamment de JB) qui me
permet, à partir d'un classeur contenant une BD importante, de créer des
classeurs distincts en fonction d'un regroupement fait à la demande de
l'utilisateur, qui choisit la colonne à partir de laquelle le
regroupement
sera fait (le détail de lamacro figure en fin du message).

Pour illustrer avec la base ci-après, si l'utilisateur choisit la
colonne A,
la macro crééra 3 classeurs ; s'il choisit la colonne D, 2 classeurs
seulement seront créés,..etc...
ANNEE Origine TYPE Test
2007 25 3 OUI
2006 10 3 OUI
2005 23 3 OUI
2006 10 3 OUI
2005 2 3 OUI
2006 3 3 OUI
2005 10 3 NON
2007 22 3 OUI
2006 25 1 OUI

Toutefois, la macro actuelle utilise une simple inputbox qui demande à
l'utilisateur de saisir manuellement l'intitulé exactde la colonne
d'en-tête
; si l'utilisateur n'entre pas exactement cet intitulé, la macro ne
fonctionne pas. Or, certains en-têtes peuvent contenir des espaces, des
caractères bizarres, etc... que l'utilisateur lambda n'appréhende pas
nécessairement...

Pour simplifier le processus, je voudrais (on y arrive enfin!) qu'une
liste
déroulante contenant l'ensemble des en-têtes de colonne de la feuille
active
(nb variable selon la feuille) soit offerte à l'utilisateur afin qu'il
n'ait
qu'à choisir dans la liste proposée pour initier le reste de la
macro........
Par ailleurs, si l'utilisateur ne choisit rien ou clique sur annuler, il
faudrait que la macro s'annule.......

Quelqu'un pourrait-il m'aider à faire évoluer la macro concernée ?

Merci d'avance !!!

Sub CreeClasseursXXX()
Application.DisplayAlerts = False

f = ActiveSheet.Name

pw = InputBox("Inscrire le libellé exact de la colonne source")

If pw <> "" Then

Range("HH1") = pw

Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[hh1], Unique:=True

For Each c In Range("HH2", Range("HH65000").End(xlUp))
Range("HH2") = c
Sheets.Add
Sheets(f).Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets(f).[HH1:HH2], CopyToRange:=[A1], Unique:úlse
ActiveSheet.Copy
ActiveWorkbook.SaveAs FileName:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets(f).Select

Next c

ActiveSheet.Range("HH1").CurrentRegion.Select
Selection.Delete
ActiveSheet.Range("A1").Select

Else
MsgBox "Essaie encore...", vbCritical, "Désolé !" 'optionnel
Range("A1").Select

End If

End Sub- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -



Avatar
JB
Bonjour,

http://cjoint.com/?dqmqFFNExo

Private Sub UserForm_Initialize()
Me.ComboBox1.List = Application.Transpose(Range("A1",
[A1].End(xlToRight)))
End Sub

Private Sub ComboBox1_Change()
[AA1] = ComboBox1
End Sub

Private Sub B_ok_Click()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
f = ActiveSheet.Name
[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[AA1], Unique:=True
For Each c In Range("AA2", Range("AA65000").End(xlUp))
Range("AA2") = c
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(f).[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets(f).[AA1:AA2], CopyToRange:=[A1],
Unique:úlse
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets(f).Select
Next c
End Sub


JB

On 16 mar, 09:44, "Orsu" wrote:
Merci à JB pour sa solution.....mais ce n'est pas exactement ce que je
cherche à faire (je n'ai pas été précis dans ma demande je m'en ap erçois
après coup).

En fait, je voudrais qu'il y ait une boite de dialogue offrant à
l'utilisateur une liste déroulante contenant l'ensemble des en-têtes d e
colonne de la feuille active (nb variable selon la feuille) afin qu'il n'a it
qu'à choisir dans la liste proposée pour initier le reste de la macro (la
localisation de la liste déroulante dans une cellule  peut dans certai nes
feuilles poser problème car les BD ont parfois un nb important de
colonnes....)

Merci d'avance pour vos conseils

"JB" a écrit dans le message de news:


http://cjoint.com/?dpuqe4cq3H

JB

On 15 mar, 20:01, JB wrote:



Bonsoir,

Le choix du critere se fait dans une liste déroulante:

Sub CreeClasseurs()
Application.DisplayAlerts = False
f = ActiveSheet.Name
[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[p1], Unique:=True
For Each c In Range("P2", Range("P65000").End(xlUp))
Range("P2") = c
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(f).[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets(f).[P1:P2], CopyToRange:=[A1],
Unique:úlse
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets(f).Select
Next c
End Sub

http://cjoint.com/?dpubL5mgur

JB

On 15 mar, 19:24, "Orsu" wrote:

Bonsoir le forum

J'ai une macro (réalisée avec l'aide du forum et notamment de JB) qui me
permet, à partir d'un classeur contenant une BD importante, de cré er des
classeurs distincts en fonction d'un regroupement fait à la demande de
l'utilisateur, qui choisit la colonne à partir de laquelle le
regroupement
sera fait (le détail de lamacro figure en fin du message).

Pour illustrer avec la base ci-après, si l'utilisateur choisit la
colonne A,
la macro crééra 3 classeurs ; s'il choisit la colonne D, 2 classeu rs
seulement seront créés,..etc...
ANNEE Origine TYPE Test
2007 25 3 OUI
2006 10 3 OUI
2005 23 3 OUI
2006 10 3 OUI
2005 2 3 OUI
2006 3 3 OUI
2005 10 3 NON
2007 22 3 OUI
2006 25 1 OUI

Toutefois, la macro actuelle utilise une simple inputbox qui demande à
l'utilisateur de saisir manuellement l'intitulé exactde la colonne
d'en-tête
; si l'utilisateur n'entre pas exactement cet intitulé, la macro ne
fonctionne pas. Or, certains en-têtes peuvent contenir des espaces, des
caractères bizarres, etc... que l'utilisateur lambda n'appréhende pas
nécessairement...

Pour simplifier le processus, je voudrais (on y arrive enfin!) qu'une
liste
déroulante contenant l'ensemble des en-têtes de colonne de la feui lle
active
(nb variable selon la feuille) soit offerte à l'utilisateur afin qu' il
n'ait
qu'à choisir dans la liste proposée pour initier le reste de la
macro........
Par ailleurs, si l'utilisateur ne choisit rien ou clique sur annuler, il
faudrait que la macro s'annule.......

Quelqu'un pourrait-il m'aider à faire évoluer la macro concernée ?

Merci d'avance !!!

Sub CreeClasseursXXX()
Application.DisplayAlerts = False

f = ActiveSheet.Name

pw = InputBox("Inscrire le libellé exact de la colonne source")

If pw <> "" Then

Range("HH1") = pw

Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[hh1], Unique:=True

For Each c In Range("HH2", Range("HH65000").End(xlUp))
Range("HH2") = c
Sheets.Add
Sheets(f).Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterC opy,
_
CriteriaRange:=Sheets(f).[HH1:HH2], CopyToRange:=[A1], Unique:=F alse
ActiveSheet.Copy
ActiveWorkbook.SaveAs FileName:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets(f).Select

Next c

ActiveSheet.Range("HH1").CurrentRegion.Select
Selection.Delete
ActiveSheet.Range("A1").Select

Else
MsgBox "Essaie encore...", vbCritical, "Désolé !" 'optionnel
Range("A1").Select

End If

End Sub- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -




Avatar
Orsu
Merci à JB mais j'ai légèrement modifié mon module initial avec un
résultat.....qui me satisfait

A toutes fins utiles, ci-joint le module dans son dernier état .

Bien cordialement,

Orsu

Sub CreeClasseurs()

Application.DisplayAlerts = False
On Error Resume Next

f = ActiveSheet.Name

Sheets(f).Activate

Set pw = Application.InputBox(prompt:="Sélectionnez une cellule", Type:=8)

If pw <> "" Then

'''On Error Resume Next

Range("HH1") = pw

Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[hh1], Unique:=True

For Each c In Range("HH2", Range("HH65000").End(xlUp))
Range("HH2") = c
Sheets.Add
Sheets(f).Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets(f).[HH1:HH2], CopyToRange:=[A1], Unique:úlse
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets(f).Select

Next c

ActiveSheet.Range("HH1").CurrentRegion.Select
Selection.Delete
ActiveSheet.Range("A1").Select

Else
MsgBox "Essaie encore...", vbCritical, "Désolé !" 'optionnel
Range("A1").Select

Exit Sub


End If

End Sub



"JB" a écrit dans le message de news:

Bonjour,

http://cjoint.com/?dqmqFFNExo

Private Sub UserForm_Initialize()
Me.ComboBox1.List = Application.Transpose(Range("A1",
[A1].End(xlToRight)))
End Sub

Private Sub ComboBox1_Change()
[AA1] = ComboBox1
End Sub

Private Sub B_ok_Click()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
f = ActiveSheet.Name
[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[AA1], Unique:=True
For Each c In Range("AA2", Range("AA65000").End(xlUp))
Range("AA2") = c
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(f).[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets(f).[AA1:AA2], CopyToRange:=[A1],
Unique:úlse
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets(f).Select
Next c
End Sub


JB

On 16 mar, 09:44, "Orsu" wrote:
Merci à JB pour sa solution.....mais ce n'est pas exactement ce que je
cherche à faire (je n'ai pas été précis dans ma demande je m'en aperçois
après coup).

En fait, je voudrais qu'il y ait une boite de dialogue offrant à
l'utilisateur une liste déroulante contenant l'ensemble des en-têtes de
colonne de la feuille active (nb variable selon la feuille) afin qu'il
n'ait
qu'à choisir dans la liste proposée pour initier le reste de la macro (la
localisation de la liste déroulante dans une cellule peut dans certaines
feuilles poser problème car les BD ont parfois un nb important de
colonnes....)

Merci d'avance pour vos conseils

"JB" a écrit dans le message de news:


http://cjoint.com/?dpuqe4cq3H

JB

On 15 mar, 20:01, JB wrote:



Bonsoir,

Le choix du critere se fait dans une liste déroulante:

Sub CreeClasseurs()
Application.DisplayAlerts = False
f = ActiveSheet.Name
[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[p1], Unique:=True
For Each c In Range("P2", Range("P65000").End(xlUp))
Range("P2") = c
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(f).[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
_
CriteriaRange:=Sheets(f).[P1:P2], CopyToRange:=[A1],
Unique:úlse
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets(f).Select
Next c
End Sub

http://cjoint.com/?dpubL5mgur

JB

On 15 mar, 19:24, "Orsu" wrote:

Bonsoir le forum

J'ai une macro (réalisée avec l'aide du forum et notamment de JB) qui
me
permet, à partir d'un classeur contenant une BD importante, de créer
des
classeurs distincts en fonction d'un regroupement fait à la demande de
l'utilisateur, qui choisit la colonne à partir de laquelle le
regroupement
sera fait (le détail de lamacro figure en fin du message).

Pour illustrer avec la base ci-après, si l'utilisateur choisit la
colonne A,
la macro crééra 3 classeurs ; s'il choisit la colonne D, 2 classeurs
seulement seront créés,..etc...
ANNEE Origine TYPE Test
2007 25 3 OUI
2006 10 3 OUI
2005 23 3 OUI
2006 10 3 OUI
2005 2 3 OUI
2006 3 3 OUI
2005 10 3 NON
2007 22 3 OUI
2006 25 1 OUI

Toutefois, la macro actuelle utilise une simple inputbox qui demande à
l'utilisateur de saisir manuellement l'intitulé exactde la colonne
d'en-tête
; si l'utilisateur n'entre pas exactement cet intitulé, la macro ne
fonctionne pas. Or, certains en-têtes peuvent contenir des espaces,
des
caractères bizarres, etc... que l'utilisateur lambda n'appréhende pas
nécessairement...

Pour simplifier le processus, je voudrais (on y arrive enfin!) qu'une
liste
déroulante contenant l'ensemble des en-têtes de colonne de la feuille
active
(nb variable selon la feuille) soit offerte à l'utilisateur afin qu'il
n'ait
qu'à choisir dans la liste proposée pour initier le reste de la
macro........
Par ailleurs, si l'utilisateur ne choisit rien ou clique sur annuler,
il
faudrait que la macro s'annule.......

Quelqu'un pourrait-il m'aider à faire évoluer la macro concernée ?

Merci d'avance !!!

Sub CreeClasseursXXX()
Application.DisplayAlerts = False

f = ActiveSheet.Name

pw = InputBox("Inscrire le libellé exact de la colonne source")

If pw <> "" Then

Range("HH1") = pw

Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=[hh1], Unique:=True

For Each c In Range("HH2", Range("HH65000").End(xlUp))
Range("HH2") = c
Sheets.Add
Sheets(f).Range("A1").CurrentRegion.AdvancedFilter
Action:=xlFilterCopy,
_
CriteriaRange:=Sheets(f).[HH1:HH2], CopyToRange:=[A1], Unique:úlse
ActiveSheet.Copy
ActiveWorkbook.SaveAs FileName:=c
ActiveWorkbook.Close
ActiveSheet.Delete
Sheets(f).Select

Next c

ActiveSheet.Range("HH1").CurrentRegion.Select
Selection.Delete
ActiveSheet.Range("A1").Select

Else
MsgBox "Essaie encore...", vbCritical, "Désolé !" 'optionnel
Range("A1").Select

End If

End Sub- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des
messages précédents -


- Afficher le texte des messages précédents -