filtrage-extraction dans un nvx fichier

[Joël Le Tanou]

Bonjour,

J'ai un classeur contenant 12 onglets : 1 par mois.
- tableau equivalent dans chaque ongles :
- date.
- code (tapé par l'opérateur)
- n° de bon
- rotation
- déchetterie (donnée récupérée avec le code) qui correspond à mes exploitations
- déchets (donnée récupérer avec le code).

j'ai une dizaine de déchetterie différentes (exploitations).

problématique :
j'ai besoin d'un fichier pour chaque déchetterie avec seulement les données de celle ci avec les données du mois correspondant.

Je mets mon tableau en pièce jointe pour que ca soit plus clair. je l'ai simplifié pour prendre moins de place.

Merci de votre aide.

 

[Joël Le Tanou]

voici le début de ma macro.

bonnardfm Macro
' Macro enregistrée le 22/07/04 par JLETANOU
'
' box de demande du mois à traiter
Dim mois
mois = InputBox("inscrivez le mois à extraire", "CHOIX DU MOIS")

' exportation du mois vers un fichier recap
Sheets(Array(mois, "table")).Copy
Sheets(mois).Cells.Copy
Sheets(mois).Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

'suppression des colonnes inutile
Columns("H:IV").Delete Shift:=xlToLeft

' tri par code et date
Columns("A:H").Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom

' sauvegarde
Dim sauvegarde
chemin = "c:\" & mois & "\recap_" & mois
sauvegarde = "C:\RECAP_" & mois
ActiveWorkbook.SaveAs FileName:=sauvegarde, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

' création de feuilles
Dim dechetterie
Dim ligne
Dim critere(1 To 2)
For ligne = 2 To 31
dechetterie = (Sheets("table").Range("B" & ligne))
critere(1) = (Sheets("table").Range("B1"))
critere(2) = (dechetterie)
MsgBox (critere(1) & critere(2))
If dechetterie = "" Then Exit For

' creation des onglets
Sheets.Add.Name = dechetterie
' creation des critère
' tri
Sheets(mois).Columns("A:G").AdvancedFilter Action:=xlFilterCopy, xlCriteria:=dechetterie, CopyToRange:=Sheets(dechetterie).Range("A1"), Unique:=False
' copie sur la feuille correspondante
' mise en page
Next
' creation d'un nouveaux doc


End Sub