Ctrl C / Ctrl V Spécial (Valeurs) d'un sous total d'une liste vers une autre feuille

**graphikris** · 11/05/2013, 15h45

Bonjour,

Je dispose d'un classeur avec 2 feuilles ( Stages et Etat numerique 2013)
Dans la 1ere (liste) avec un sous total, je dois extraire vers la feuille 2, le sous total en fonction de 3 critéres (date début : >= au 01/10/2012) _ (date fin : <= au 31/03/2013) _ (Indices).
Lorsque j'ai créé la macro, les sous totaux étaient exacts mais lorsque j'ai voulu déclencher automatiquement la macro, tous les sous totaux retourne la valeur 0 "Zéro".
J'ai mis sur la feuil 2 (I11:I19) les bons sous totaux.

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Sub Macro3()
'
' Macro3 Macro
' Macro enregistrée le 11/05/2013 par Graphikris
'
 
'
    Selection.AutoFilter Field:=4, Criteria1:=">=01/10/2012", Operator:=xlAnd
    Selection.AutoFilter Field:=5, Criteria1:="<=31/03/2013", Operator:=xlAnd
    Selection.AutoFilter Field:=2, Criteria1:="=27000", Operator:=xlAnd
    Range("F25").Select
    Selection.Copy
    Sheets("Etat numerique 2013").Select
    Range("F11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Stages").Select
    Selection.AutoFilter Field:=2, Criteria1:="=27001", Operator:=xlAnd
    Range("F25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Etat numerique 2013").Select
    Range("F12").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Interior.ColorIndex = xlNone
    Selection.Font.Bold = False
    Sheets("Stages").Select
    Selection.AutoFilter Field:=2, Criteria1:="=27002", Operator:=xlAnd
    Range("F25").Select
    Selection.Copy
    Sheets("Etat numerique 2013").Select
    Range("F13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Stages").Select
    Selection.AutoFilter Field:=2, Criteria1:="=27003", Operator:=xlAnd
    Range("F25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Etat numerique 2013").Select
    Range("F14").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Font.Bold = False
    Selection.Interior.ColorIndex = xlNone
    Range("F15").Select
    Sheets("Stages").Select
    Selection.AutoFilter Field:=2, Criteria1:="=27308", Operator:=xlAnd
    Range("F25").Select
    Selection.Copy
    Sheets("Etat numerique 2013").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Stages").Select
    Selection.AutoFilter Field:=2, Criteria1:="27306"
    Range("F25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Etat numerique 2013").Select
    Range("F16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Stages").Select
    Selection.AutoFilter Field:=2, Criteria1:="27304"
    Range("F25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Etat numerique 2013").Select
    Range("F17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Stages").Select
    Selection.AutoFilter Field:=2, Criteria1:="27303"
    Range("F25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Etat numerique 2013").Select
    Range("F18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Stages").Select
    Selection.AutoFilter Field:=2, Criteria1:="25373"
    Range("F25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Etat numerique 2013").Select
    Range("F19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F22").Select
    Sheets("Stages").Select
    Selection.AutoFilter Field:=2
    Selection.AutoFilter Field:=4
    Selection.AutoFilter Field:=5
    ActiveWindow.SmallScroll Down:=-6
    Sheets("Etat numerique 2013").Select
End Sub

J'ai joint mon classeur au cas où quelqu'un trouve une solution.

Merci.

**Daniel.C** · 11/05/2013, 16h36

Bonjour,

Mets les dates au format mm/jj/aaaa dans les filtres automatiques.

**graphikris** · 11/05/2013, 17h04

Bonjour Daniel,

mais où ? ici lignes 8 et 9 ?
j'ai essayé mais çà bug (normal)

Code :

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

1
2
3
4
5
6
7
8
9
Sub Macro3()
'
' Macro3 Macro
' Macro enregistrée le 11/05/2013 par Graphikris
'
 
'
    Selection.AutoFilter Field:=4, Criteria1:=">=01/10/2012", Operator:=xlAnd
    Selection.AutoFilter Field:=5, Criteria1:="<=31/03/2013", Operator:=xlAnd

Faut il faire dans la macro un chgt de format de date des colonnes D et E ?
puis mettre le code actuel et en fin de macro remettre les formats français ?

Cordialement,
Graphikris

**gFZT82** · 11/05/2013, 18h06

Bonjour,

Essaie comme cela

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
28
29
30
31
Sub Macro3()
Dim WsS As Worksheet
Dim WsC As Worksheet
Dim LaDate1 As Date, LaDate2 As Date
Dim Tablo
Dim i As Byte
 
    Set WsS = Worksheets("Stages")
    Set WsC = Worksheets("Etat numerique 2013")
 
    Application.ScreenUpdating = False
 
    LaDate1 = CDate("01/10/2012")
    LaDate2 = CDate("31/03/2013")
    WsS.Range("A1:F1").AutoFilter Field:=4, Criteria1:=">=" & Format(LaDate1, "mm/dd/yyyy"), Operator:=xlAnd
    WsS.Range("A1:F1").AutoFilter Field:=5, Criteria1:="<=" & Format(LaDate2, "mm/dd/yyyy"), Operator:=xlAnd
 
    Tablo = Array("27000", "27001", "27002", "27003", "27308", "27306", "27304", "27303", "25373")
    For i = 0 To UBound(Tablo)
        WsS.Range("A1:F1").AutoFilter Field:=2, Criteria1:="=" & Tablo(i), Operator:=xlAnd
        WsS.Range("F24").Copy
        WsC.Range("F11").Offset(i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Next i
 
    Application.CutCopyMode = False
    WsS.Range("A1:F1").AutoFilter
    Sheets("Etat numerique 2013").Select
    Range("D9").Select
    Set WsC = Nothing: Set WsS = Nothing
End Sub

Cordialement.

**graphikris** · 11/05/2013, 18h28

Bjr et merci mais çà buggue a la ligne 22

Cordialement

**Daniel.C** · 11/05/2013, 18h48

Testé :

Code :

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

1
2
    Selection.AutoFilter Field:=4, Criteria1:=">=10/01/2012", Operator:=xlAnd
    Selection.AutoFilter Field:=5, Criteria1:="<=03/31/2013", Operator:=xlAnd

Je peux te joindre un classeur exemple.

Tu peux aussi mettre :

Code :

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

1
2
    Selection.AutoFilter Field:=4, Criteria1:=">=" & DateSerial(2012, 10, 1)
    Selection.AutoFilter Field:=5, Criteria1:="<=" & DateSerial(2013, 3, 31)

**Docmarti** · 12/05/2013, 15h25

Je soupconne que dans tes Options Régionales et linguistiques dans Windows, le format de Dates ne reconnaît pas le format "01/10/2012" que tu utilises dans ton code : Criteria1:=">=01/10/2012".

Le seul format de dates qui est toujours interprété correctement en VBA, indépendamment des options régionales, est le format américain : "2012/10/01" (Année/Mois/Jour).

Donc remplace Criteria1:=">=01/10/2012"
par Criteria1:=">=2012/10/01"
et vois si ca change les résultats de ton filtre.

**graphikris** · 12/05/2013, 18h32

Merci à vous 3 pour vos reponses mais j'ai toujours un doute lorsque je fais un clic droit (format de cellule), je choisis quoi comme parametre regional dans date ?

Américain n'existe pas et Anglais, il y en a plusieurs.

Voici le code quelques peu modifié car les dates de debut et fin peuvent varier :

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
28
29
30
Sub Requete_Etat_Numerique_CSI()
 
 
Sheets("Stages").Select
 
Dim Datedebut As Date
Dim Datefin As Date
 
Datedebut = InputBox("Veuillez saisir la date de début du Retex :" & Chr$(13) & Chr$(13) & "Exemple :" & Chr$(13) & Chr$(13) & "jour/mois/année" & Chr$(13) & Chr$(13) & "jj/mm/aa" & Chr$(13) & "Pour le 1er Octobre 2012 saisir : " & Chr$(13) & "01/10/12" & Chr$(13) & Chr$(13) & "ATTENTION : la saisie est obligatoire.", "Date début du Retex")
Datefin = InputBox("Veuillez saisir la date de fin du Retex :" & Chr$(13) & Chr$(13) & "Exemple :" & Chr$(13) & "jour/mois/année" & Chr$(13) & Chr$(13) & Chr$(13) & "jj/mois/aa" & Chr$(13) & "Pour le 31 Mars 2013 saisir : " & Chr$(13) & "31/03/13" & Chr$(13) & Chr$(13) & "ATTENTION : la saisie est obligatoire.", "Date fin du Retex")
Dim shtFrom As Worksheet, shtTo As Worksheet, List As ListObject
 
With ThisWorkbook
  Set shtFrom = .Worksheets("Stages")
  Set shtTo = .Worksheets("Etat numerique 2013")
End With
 Set List = shtFrom.ListObjects("Liste1")
With List
 With .DataBodyRange
 .AutoFilter Field:=11, Criteria1:=">="" & Datedebut", Operator:=xlAnd
 .AutoFilter Field:=12, Criteria1:="<="" & Datefin", Operator:=xlAnd
 .AutoFilter Field:=2, Criteria1:="ADC"
End With
 .TotalsRowRange.Offset(, .ListColumns.Count - 1).Resize(1, 1).Copy
End With
 shtTo.Range("F16").PasteSpecial xlPasteValues
 
Sheets("Etat Numerique 2013").Select
 
End Sub

En attente de vos reponses,
Cordialement Graphikris.

**SfJ5Rpw8** · 12/05/2013, 18h46

Bonjour,

sans regarder le fonctionnement, juste la syntaxe , grâce au code coloré par le forum .. tes variables DatesDebut ... doivent être en dehors des guillemets et donc de couleur noire .. partout ou tu les vois en rouge il y as un problème de guillemets..

**graphikris** · 12/05/2013, 18h52

Bonjour et merci pour l'info, voici le code modifié :

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
28
29
30
31
32
33
34
35
36
Sub Requete_Etat_Numerique_CSI()
 
 
Sheets("Stages").Select
Columns("K:L").Select
    Selection.NumberFormat = "mm/dd/yyyy"
 
Dim Datedebut As Date
Dim Datefin As Date
 
Datedebut = InputBox("Veuillez saisir la date de début du Retex :" & Chr$(13) & Chr$(13) & "Exemple :" & Chr$(13) & Chr$(13) & "jour/mois/année" & Chr$(13) & Chr$(13) & "jj/mm/aa" & Chr$(13) & "Pour le 1er Octobre 2012 saisir : " & Chr$(13) & "01/10/12" & Chr$(13) & Chr$(13) & "ATTENTION : la saisie est obligatoire.", "Date début du Retex")
Datefin = InputBox("Veuillez saisir la date de fin du Retex :" & Chr$(13) & Chr$(13) & "Exemple :" & Chr$(13) & "jour/mois/année" & Chr$(13) & Chr$(13) & Chr$(13) & "jj/mois/aa" & Chr$(13) & "Pour le 31 Mars 2013 saisir : " & Chr$(13) & "31/03/13" & Chr$(13) & Chr$(13) & "ATTENTION : la saisie est obligatoire.", "Date fin du Retex")
Dim shtFrom As Worksheet, shtTo As Worksheet, List As ListObject
 
With ThisWorkbook
  Set shtFrom = .Worksheets("Stages")
  Set shtTo = .Worksheets("Etat numerique 2013")
End With
 Set List = shtFrom.ListObjects("Liste1")
With List
 With .DataBodyRange
 .AutoFilter Field:=11, Criteria1:=">=" & Datedebut, Operator:=xlAnd
 .AutoFilter Field:=12, Criteria1:="<=" & Datefin, Operator:=xlAnd
 .AutoFilter Field:=2, Criteria1:="27306"
End With
 .TotalsRowRange.Offset(, .ListColumns.Count - 1).Resize(1, 1).Copy
End With
 shtTo.Range("F16").PasteSpecial xlPasteValues
 
Sheets("Stages").Select
Columns("K:L").Select
Selection.NumberFormat = "m/d/yyyy"
 
Sheets("Etat Numerique 2013").Select
 
End Sub

**Philippe Tulliez** · 12/05/2013, 19h00

Bonjour,

Merci à vous 3 pour vos reponses mais j'ai toujours un doute lorsque je fais un clic droit (format de cellule), je choisis quoi comme parametre regional dans date ?
Américain n'existe pas et Anglais, il y en a plusieurs.

Le format régional n'a rien à voir avec Excel mais dépend des paramètres régionaux de Windows mais je pense que ce n'est pas ton cas.
Il faudrait pour cela que entre autres le séparateur de milliers soit une virgule, le séparateur d'arguments dans les formules d'excel soit une virgule etc...

Bonsoir,

Voici le code quelques peu modifié car les dates de debut et fin peuvent varier :

Si tes paramètres changent régulièrement et c'est normal. Il faudrait que tu utilises une procédure (Sub ou Function) avec arguments.
C'est la seule manière de rendre une application pérenne.
J'ajoute que tu utilises encore des méthodes telles que Select alors que l'on répète sans arrêt sur ce forum que c'est parfaitement inutile et ralenti l'exécution du programme.

Ctrl C / Ctrl V Spécial (Valeurs) d'un sous total d'une liste vers une autre feuille [XL-2003]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager