Trier un tableau par date et copie de la selection dans une autre feuille

[mar82]

Bonjour

je suis depuis hier sur un programme pour trier un tableau par dates, et copier ce tri sur une autre feuille.
Voici mon code

Code :

1.Sub Macro8()
2.
3.'lire les dates
4.
5.Dim dat1#, dat2#, plage As Range
6.
7.Sheets("page destination" ).Select
8.
9.
10.dat1 = CDbl(Cells(5, 4))
11.
12.dat2 = CDbl(Cells(5, 6))
13.
14.
15.D = Sheets("page destination" ).UsedRange.Rows.Count
16.If D > 10 Then
17.Range(Cells(11, 1), Cells(D, 24)).Clear
18.End If
19.
20.
21.'filtrer
22.Sheets("page input" ).Select
23.
24.c = Sheets("page input" ).UsedRange.Rows.Count
25.Application.ScreenUpdating = False
26.Sheets("page input" ).AutoFilterMode = False
27.Set plage = Range("A7", [I65536].End(xlUp))
28.plage.AutoFilter 9, ">=" & dat1, xlAnd, "<=" & dat2
29.plage.Copy
30.
31.Sheets("page destination" ).Select
32.Range("a11" ).Select
33.plage.PasteSpecial xlPasteFormats
34.plage.PasteSpecial Paste:=xlPasteValues
35.
36.
37.Call macro9
38.Sheets("page destination" ).Select
39.Range("a11" ).Select
40.
41.
42.End Sub
43.
44.Sub macro9()
45.Sheets("page input" ).Select
46.Range("a1:x6" ).Activate
47.Sheets("page input" ).EnableAutoFilter = True
48.Range("a7" ).Select
49.
50.End Sub

J'ai plusierus fois tester des codes différents pour l'écriture de l'autofilter et j'ai à chaque fois la même erreur de compilation:
en allemand "Laufzeitfehler 1004". C'est en allemand, mais en gros la ligne d'autofilter est surlignée en jaune et dû à cette erreur, la macro ne marche pas.

C'es t pour le boulot, et je n'en peux plus de chercher.

Vous avez pas une idée

merci beaucoup

 

[flyonets44]

Re : Trier un tableau par date et copie de la selection dans une autre feuille

bonjour
Essaie ce code pour voir si çà fonctionne
et tu adaptes à tes besoins
Sub Quickfilter()
Dim Vplage As Range, Y&, Cible As Range
Application.ScreenUpdating = False
'Source = Feuil1
Y = Feuil1.Cells(65536, 1).End(xlUp).Row
'la colonne à filtrer=A
Set Vplage = Feuil1.Range(Cells(1, 1), Cells(Y, 1))
Set Cible = Feuil2.Range("C1") 'A déterminer
Application.Goto reference:=Cible, Scroll:=False
Vplage.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cible _
, Unique:=True
Set Vplage = Nothing: Set Cible = Nothing
Application.ScreenUpdating = True
End Sub
Cordialement
flyonets