Excel : Macro pour bdd, filtre et génération de fichiers
Le
Raphaël Pauliat
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
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
l'enregistreur de macro ;-)
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+
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" 425617d4$0$2229$
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"