Création d'une macro tri + enregistre selon certains critères

Création d'une macro tri + enregistre selon certains critères - VB/VBA/VBS - Programmation

Marsh Posté le 08-05-2008 à 17:45:32    

bonjour à tous
 
voila j'ai besoin d'un peu d'aide pour créer une macro.
sur un classeur excel, j'ai un tableau contenant de nombreuses colonnes dont une colonne NOM et une DATE.
Je souhaiterais une macro me créant un nouveau classeur pour chaque nouveau nom en intégrant l'ensemble de la ligne qui correspond au nom, et enregistrant ce nouveau classeur dans un répertoire qui n'existe pas mais qui devrait être créé et avoir pour chemin C:/Client/NOM.
Il faudrait également créer un sous répertoire par date en fonction des noms.
 
Quelqu'un peut-il m'aider à résoudre mon problème, j'ai la tête dans les bouquins de programmation VBA mais je dois dire que je ne m'en sort pas du tout.

Reply

Marsh Posté le 08-05-2008 à 17:45:32   

Reply

Marsh Posté le 08-05-2008 à 20:32:51    

salut
ca peut te servir d'ossature
 
Sub Macro1()
nombredelignes = Sheets("Feuil1" ).Range("a6555" ).End(xlUp).Row
Range("A1:B" & nombredelignes).Sort Key1:=Range("A2" ), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
 
'en supposant qur ta feuille données soit la premiere feuille
Sheets("Feuil1" ).Select
Sheets("Feuil1" ).Copy Before:=Sheets(1)
Sheets(1).Select
Sheets(1).Name = "duplicat"
 
 
For i = nombredelignes To 2 Step -1
valeura = Cells(i, 1) 'en supposant que la colonne NOM est la premiere
valeurb = Cells(i - 1, 1)
If valeura = valeurb Then
Rows(i).Select
Selection.Delete Shift:=xlUp
End If
Next i
'il n'y as plus que des noms distinct --> on les récupere ds un tableau
nbl2 = Sheets("Duplicat" ).Range("a6555" ).End(xlUp).Row
Dim myarray(5000, 1) As String
For i = 2 To nbl2 Step 1
myarray(i - 1, 1) = Cells(i, 1)
Next
nombreref = i - 1
Application.DisplayAlerts = False
Sheets("duplicat" ).Delete
 
For i = 1 To nombreref Step 1
'filtrer
Sheets("Feuil1" ).Select
Sheets("Feuil1" ).Range("A1:B" & nombredelignes).Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$B$" & nombredelignes).AutoFilter Field:=1, Criteria1:=myarray(1, 1)
'copier
'creer fichier
Next
 
End Sub

Reply

Sujets relatifs:

Leave a Replay

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