Discussion :

[anelinette]

Bonjour,
j'ai trouve cette macro sur le net et j'aimerai la réutiliser
dans le fichier elle extrait les 2 colonnes et moi j'aimerai en extraire 5 je ne vois pas comment faire
pouvez vous m'aider

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
    Sub Extraction()
 
    ' Extraction entre deux dates
    ' Critères de dates     - Feuil1
    ' Base de données       - Feuil2
    ' Extraction            - Feuil3
 
    Sheets("Feuil3").Range("A1").CurrentRegion.Clear
 
      With Sheets("Feuil2")
        Application.CutCopyMode = False
        .Rows(5).Insert                                                 'en-tête
       .Range("a1") = "date"                                           'en-tête
       .Range("b1") = "Designation"                                    'en-tête
       .Range("c1") = "valeur"                                         'en-tête
       .Range("E2") = "=AND(a2>=Feuil1!A3,a2<=Feuil1!B3)"              'critères
 
        .Range("A1:B" & .Cells(Rows.Count, 5).End(xlUp).Row) _
        .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        .Range("E1:E2"), CopyToRange:=Sheets("Feuil3").Range("a1:b1"), Unique:=False
        .Range("E2") = ""
        .Rows(1).Delete
      End With
    End Sub

merci par avance de vos réponses

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
    Sub Extraction()
 
    ' Extraction entre deux dates
    ' Critères de dates     - Feuil1
    ' Base de données       - Feuil2
    ' Extraction            - Feuil3
 
    Sheets("Feuil3").Range("A1").CurrentRegion.Clear
 
      With Sheets("Feuil2")
        Application.CutCopyMode = False
        .Rows(5).Insert                                                 'en-tête
       .Range("a1") = "date"                                           'en-tête
       .Range("b1") = "Designation"                                    'en-tête
       .Range("c1") = "valeur"                                         'en-tête
       .[d1] = "en-têt4"
       .[e1] = "en-têt5"
       .Range("E2") = "=AND(a2>=Feuil1!A3,a2<=Feuil1!B3)"              'critères
 
        .Range("A1:E" & .Cells(Rows.Count, 5).End(xlUp).Row) _
        .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        .Range("E1:E5"), CopyToRange:=Sheets("Feuil3").Range("a1:e1"), Unique:=False
        .Range("E2") = ""
        .Rows(1).Delete
      End With
    End Sub

[anelinette]

Bonjour rdurupt et merci

Ca fonctionne mais plus avec le critère des dates
je joint le fichier

vero_extraire.xlsvero_extraire.xls