Macro excel VBA complexe sur Filtre auto + récupération des données...

Macro excel VBA complexe sur Filtre auto + récupération des données... - VB/VBA/VBS - Programmation

Marsh Posté le 06-04-2005 à 13:38:48    

Bonjour à tous,
 
je dois faire une macro et je dois dire que je rame à mort... J'ai un fichier avec une bdd. Il y a une colonne Ville dans ce fichier. Je voudrais, pour tous les enregistrements de chaque ville, les copier dans un nouveau fichier excel qui se nommera "nom_ville.xls" et qui sera protégé en écriture...
 
Je pensais faire un filtre auto et, par vba, récupérer tous les noms de ville que l'on voit dans la liste déroulante du filtre...  
 
Quelqu'un peut-il m'aider ??? je suis désespéré...
 
Merci d'avance.

Reply

Marsh Posté le 06-04-2005 à 13:38:48   

Reply

Marsh Posté le 06-04-2005 à 20:50:54    

'Ajouter une feuille à un classeur et la nommer, après vérification
'de la validité du nom et correction si besoin.
'cette fonction est un peu une synthèse d'une fonction de Chip Pearson
'(du même nom : CreateSheet) et de procédures de ChrisV pour vérifier
'la validité d'un nom affecté à une nouvelle feuille
 
Sub TestFeuilles()
Dim sht As Worksheet
  CreateSheet "Rapport du 12/12/2001"
  CreateSheet "azeazeaze*azezaezae/azeazazezerzererertdfgdfgfghfgh?ppoio"
  CreateSheet ""
  CreateSheet "Sommaire"
  Set sht = CreateSheet("La dernière" )
  MsgBox sht.Name
End Sub
 
Function CreateSheet(SheetName As String) As Excel.Worksheet
'avec l'aide de Chip Pearson, mpep et de ChrisV, mpfe
Dim i As Byte
   
  'si le nom de la nouvelle feuille est une chaîne vide -> nom par défaut
  If SheetName = "" Then GoTo ErrH
   
  'si le nom comprend des caractères interdits -> trait d'union
  For i = 1 To Len(SheetName)
    Select Case Mid(SheetName, i, 1)
      Case ":", "/", "\", "?", "*", "[", "]": Mid(SheetName, i, 1) = "-"
    End Select
  Next
   
  'si le nom est trop long -> tronqué à 31 caractères
  If Len(SheetName) > 31 Then
    SheetName = Left(SheetName, 31)
  End If
   
  'si la feuille existe déjà -> renvoi de la feuille existante
  On Error GoTo ErrH:
  Set CreateSheet = ThisWorkbook.Worksheets(SheetName)
  Exit Function
   
ErrH:
 
  'tout est OK -> création de la feuille
  Set CreateSheet = ThisWorkbook.Worksheets.Add
  'affectation du nom (ou maintien du nom par défaut)
  If SheetName <> "" Then CreateSheet.Name = SheetName
   
End Function 'fs
 
 
voila ce que j'ai en exemple pour une feuille
a toi de faire varier sheetname pour avoir tout tes noms

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed