Excel : Macro pour bdd, filtre et génération de fichiers

Déjà, pour dégrossir la chose, tu pourrais peut-être mettre en route
l'enregistreur de macro ;-)

bonjour,

Option Explicit

Dim wbk As Workbook
Sub cellulesvisibles()

Dim Tabentree, Sandoublons As New Collection
Dim plagefiltre As Range, plagefiltrevisible As Range, i As Integer,
nbchamps As Integer

'on invalide le raffraichissement de l'écran

Application.ScreenUpdating = False

'on initialise une variable , en prévision de la suite

Set wbk = ActiveWorkbook

'on donne le nombre de champs composant le filtre, dans l'exemple j'en ai 11
nbchamps = 11

'on remet l'ensemble des filtres à blanc pour être bien sur ensuite
d'obetnir toutes les occurences que l'on souhaite

For i = 1 To nbchamps
Selection.AutoFilter field:=i
Next

'on affecte à une variable la zone de filtre

Set plagefiltre = ActiveSheet.AutoFilter.Range

'on commence par déterminer le nombre de villes différentes en constituant
une collection des villes sans doublons
'ici les villes sont dans le champ N°8, donc on s'interesse à la colonne 8

Tabentree = plagefiltre.Columns(8).Value

For i = LBound(Tabentree, 1) To UBound(Tabentree, 1)
On Error Resume Next
Sandoublons.Add Tabentree(i, 1), CStr(Tabentree(i, 1))
Next
On Error GoTo 0

'une fois déterminée le nombre de villes, on va parcourir la collection pour
faire autant de fois une recherche
'filtrée qu'il y a de villes
'on part de i=2 pour ne pas prendre le nom de l'entete

For i = 2 To Sandoublons.Count

'ici la recherche se fait sur le champ N°8
plagefiltre.AutoFilter field:=8, Criteria1:=Sandoublons(i)
Set plagefiltrevisible = plagefiltre.SpecialCells(xlCellTypeVisible)
'on réalise l'opération de copie
plagefiltrevisible.Copy
creerfichierdest Sandoublons(i)
'on passe à la ville suivante
Next

'on remet l'ensemble des filtres à blanc

For i = 1 To nbchamps
Selection.AutoFilter field:=i
Next

'on reset la collection

Set Sandoublons = Nothing

'on remet le raffraichissement de l'écran

Application.ScreenUpdating = False

End Sub

Sub creerfichierdest(nomville As String)

'pour eviter le message de confirmaion d'écrasement d'un fichier dèjà existant
Application.DisplayAlerts = False

'on crée un nouveau fichier
Workbooks.Add

'on copie les données
ActiveSheet.Paste

'on libère le presse-papiers
Application.CutCopyMode = False

'on enregistre le fichier portant le nom de la ville dans un répertoire que
l'on a préalablement choisi: ici C:toto. Il faut bien sur que ce répertoire
existe
'on met un mdp pour permettre qu'à l'ouverture si le mdp n'est pas frappé,
le fichier s'ouvre en lecture seule
'si le fichier existe déjà dans le répertoire, on delete l'ancien et on en
met un nouveau à la place

On Error Resume Next
With ActiveWorkbook
.SaveAs "C:toto" & nomville & ".xls", , , "mdp"
If Err.Number <> 0 Then
Err.Clear
Kill "C:toto" & nomville & ".xls"
.SaveAs "C:toto" & nomville & ".xls", , , "mdp"
End If
.Close
End With

'on revient au fichier source

wbk.Activate

End Sub

A+

Bonjour tout le monde,

J'ai un fichier avec une bdd et dedans, une colonne avec des noms de Ville.
Jusque là, pas de soucis.
Je voudrais, par macro, extraire toutes les données concernant une ville et
les copier dans un nouveau fichier (et non feuille) excel, enregistrer ce
fichier sous "Ville.xls" et mettre une protection en écriture...

Première étape : sélectionner les infos pour chaque ville. Je pensais faire
un filtre auto mais je ne sais pas comment, par vba, faire une boucle en le
faisant prendre comme Criteria1, chaque ville...

Worksheets("Sheet1").Range("A1").AutoFilter _
field:=1, _
Criteria1:="Otis"
VisibleDropDown:úlse

L'autre solution consiste à faire la liste des villes dans une autre feuille
et la parcourir via vba...

Déjà, un coup de main ici serait plus que bienvenue...

Seconde étape :

Le copier coller dans une nouvelle feuille. Là, aucune idée...

Troisième étape :

Enregistrement du fichier sous le nom de la ville et mise en place de la
protection + fermeture du fichier...

Encore aucune idée...

Help !!

Merci d'avance ! Toute contribution sera bienvenue !

Raph

Bonsoir Raphael,

D'abord, compliments à AnonymousA qui a fait un travail remarquable.

Idée première contournement sans macro:
Plutôt filtre élaboré puis enregistrer sur une liste comme ton idée mais...
Un tableau croisé permet de mettre les montants (tous renseignés d'un des
champs valeur potentiels de Ville)
A condition d'avoir viré la coche à cette modification directe dans le menu
Outils options modifications
on peut Afficher des pages par dblclic sur la valeur d'un TCD correspondant
au champ choisi
ce qui est une solution alternative pratique ...et reste plus qu'à les
enregistrer.

Mais comme tu voulais du VBA :

Me voili parti la dessus , un peu comme on aurait fait avec l'idée future
de boucler sur la liste filtrée pour procèder aux extractions avec un filtre
élaboré.
Puis grâce à toi voici que je me suis créé un extracteur de liste sans
doublons alors

Merci à toi.
je la donne qd même avec la cerise non pas sur mais au bout du gateau et
m'en vais apprendre la recette des chocolats à 5 ou 6 grammes .

'********
'***Création d'une liste sans doublons******
'**Definition des variables globales
Public sRc As String
Public Dest As String
'********
Sub AdcollSh()
'**Definition des variables locales
Dim Sh As Worksheet
Dim Catlist As New Collection
'***affichage du userform
SaisieRg.Show
'***

'***création de la liste
On Error Resume Next
For Each c In Range(sRc).Cells
If IsEmpty(c) Then Exit For
Catlist.Add c, CStr(c)
Next c
On Error GoTo 0
'****
'**si pas de destination nvl feuille
If Len(Dest) = 0 Then
Set Sh = ActiveWorkbook.Sheets.Add _
(after:=Worksheets(ActiveWorkbook.Worksheets.Count))
Dest = Sh.Range("b1").Address
End If
'*****
'**affectation de la liste
For i = 1 To Catlist.Count
Range(Dest).Offset(i - 1, 0) = Catlist(i)
Next i

Set Sh = Nothing
End Sub
'***

'****
'puis dans le code du Userform nommé SaisieRg
'qui comporte deux refedit et boutons ok et annuler
'****
Private Sub CommandButton1_Click()

sRc = Me.RefEdit1.Value
Dest = Me.RefEdit2.Value


SaisieRg.Hide

End Sub

Private Sub CommandButton2_Click()
SaisieRg.Hide
End
End Sub

Private Sub userform_Initialize()
RefEdit1.Text = Selection.Address
RefEdit2.Text = ""

End Sub
'****
'lSteph

'( qui finalement se rend compte que données consolidation étiquettes
colonne de gauche permet de faire approximativement la même chose)
'A.B.E.Salut

"Raphaël Pauliat" <rpauliat@free.fr> a écrit dans le message de news:
425617d4$0$2229$626a14ce@news.free.fr...

Bonjour tout le monde,

J'ai un fichier avec une bdd et dedans, une colonne avec des noms de
Ville. Jusque là, pas de soucis.
Je voudrais, par macro, extraire toutes les données concernant une ville
et les copier dans un nouveau fichier (et non feuille) excel, enregistrer
ce fichier sous "Ville.xls" et mettre une protection en écriture...

Première étape : sélectionner les infos pour chaque ville. Je pensais
faire un filtre auto mais je ne sais pas comment, par vba, faire une
boucle en le faisant prendre comme Criteria1, chaque ville...

Worksheets("Sheet1").Range("A1").AutoFilter _
field:=1, _
Criteria1:="Otis"
VisibleDropDown:úlse

L'autre solution consiste à faire la liste des villes dans une autre
feuille et la parcourir via vba...

Déjà, un coup de main ici serait plus que bienvenue...

Seconde étape :

Le copier coller dans une nouvelle feuille. Là, aucune idée...

Troisième étape :

Enregistrement du fichier sous le nom de la ville et mise en place de la
protection + fermeture du fichier...

Encore aucune idée...

Help !!

Merci d'avance ! Toute contribution sera bienvenue !

Raph

Bonjour,

Ouah, bravo à tous, merci pour vos conseils et vos codes ! Je ne pensais pas
que vous feriez tout ! :-) Je n'ai pas encore pu tester (le fichier n'est
pas chez moi) mais franchement, merci bcp bcp !

Bon week-end à tous

Raph


"LSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
O0TkmYHPFHA.1268@TK2MSFTNGP14.phx.gbl...

Bonsoir Raphael,

D'abord, compliments à AnonymousA qui a fait un travail remarquable.

Idée première contournement sans macro:
Plutôt filtre élaboré puis enregistrer sur une liste comme ton idée
mais...
Un tableau croisé permet de mettre les montants (tous renseignés d'un des
champs valeur potentiels de Ville)
A condition d'avoir viré la coche à cette modification directe dans le
menu Outils options modifications
on peut Afficher des pages par dblclic sur la valeur d'un TCD
correspondant au champ choisi
ce qui est une solution alternative pratique ...et reste plus qu'à les
enregistrer.

Mais comme tu voulais du VBA :

Me voili parti la dessus , un peu comme on aurait fait avec l'idée future
de boucler sur la liste filtrée pour procèder aux extractions avec un
filtre élaboré.
Puis grâce à toi voici que je me suis créé un extracteur de liste sans
doublons alors

Merci à toi.
je la donne qd même avec la cerise non pas sur mais au bout du gateau et
m'en vais apprendre la recette des chocolats à 5 ou 6 grammes .

'********
'***Création d'une liste sans doublons******
'**Definition des variables globales
Public sRc As String
Public Dest As String
'********
Sub AdcollSh()
'**Definition des variables locales
Dim Sh As Worksheet
Dim Catlist As New Collection
'***affichage du userform
SaisieRg.Show
'***

'***création de la liste
On Error Resume Next
For Each c In Range(sRc).Cells
If IsEmpty(c) Then Exit For
Catlist.Add c, CStr(c)
Next c
On Error GoTo 0
'****
'**si pas de destination nvl feuille
If Len(Dest) = 0 Then
Set Sh = ActiveWorkbook.Sheets.Add _
(after:=Worksheets(ActiveWorkbook.Worksheets.Count))
Dest = Sh.Range("b1").Address
End If
'*****
'**affectation de la liste
For i = 1 To Catlist.Count
Range(Dest).Offset(i - 1, 0) = Catlist(i)
Next i

Set Sh = Nothing
End Sub
'***

'****
'puis dans le code du Userform nommé SaisieRg
'qui comporte deux refedit et boutons ok et annuler
'****
Private Sub CommandButton1_Click()

sRc = Me.RefEdit1.Value
Dest = Me.RefEdit2.Value


SaisieRg.Hide

End Sub

Private Sub CommandButton2_Click()
SaisieRg.Hide
End
End Sub

Private Sub userform_Initialize()
RefEdit1.Text = Selection.Address
RefEdit2.Text = ""

End Sub
'****
'lSteph

'( qui finalement se rend compte que données consolidation étiquettes
colonne de gauche permet de faire approximativement la même chose)
'A.B.E.Salut

"Raphaël Pauliat" <rpauliat@free.fr> a écrit dans le message de news:
425617d4$0$2229$626a14ce@news.free.fr...

Bonjour tout le monde,

J'ai un fichier avec une bdd et dedans, une colonne avec des noms de
Ville. Jusque là, pas de soucis.
Je voudrais, par macro, extraire toutes les données concernant une ville
et les copier dans un nouveau fichier (et non feuille) excel, enregistrer
ce fichier sous "Ville.xls" et mettre une protection en écriture...

Première étape : sélectionner les infos pour chaque ville. Je pensais
faire un filtre auto mais je ne sais pas comment, par vba, faire une
boucle en le faisant prendre comme Criteria1, chaque ville...

Worksheets("Sheet1").Range("A1").AutoFilter _
field:=1, _
Criteria1:="Otis"
VisibleDropDown:úlse

L'autre solution consiste à faire la liste des villes dans une autre
feuille et la parcourir via vba...

Déjà, un coup de main ici serait plus que bienvenue...

Seconde étape :

Le copier coller dans une nouvelle feuille. Là, aucune idée...

Troisième étape :

Enregistrement du fichier sous le nom de la ville et mise en place de la
protection + fermeture du fichier...

Encore aucune idée...

Help !!

Merci d'avance ! Toute contribution sera bienvenue !

Raph