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)

**graphikris** · 11/05/2013, 19h07

Re,

Chez moi çà bug, peux tu me joindre un fichier exemple ,stp

Merci

**gFZT82** · 11/05/2013, 19h45

Re-bonjour,

De mon coté, pas de problème.

**graphikris** · 11/05/2013, 19h53

Re,
Je viens de tester le fichier exemple joint et j'obtiens le chiffre 44 dans toutes les cellules de F11 à F19.
De plus sur la feuille stages, plus possible de faire apparaitre les filtres sur la ligne 1.

En attente de votre reponse,

Cordialement

**Daniel.C** · 11/05/2013, 20h17

Regarde le classeur joint.

**Daniel.C** · 11/05/2013, 20h24

Bonjour gFZT82,

Ton code ne fait que transformer la date au format texte "mm/jj/aaa" :

"LaDate1" convertit le texte au format date.

"Format(LaDate1, "mm/dd/yyyy")" convertit la variable au format texte "mm/jj/aaaa"

Tu transformes un string format "jj/mm/aaaa" en un string au format "mm/jj/aaaa". C'est donc plus direct d'utiliser ce dernier format pour le filtre, n'est-ce pas ton avis ?

**Philippe Tulliez** · 11/05/2013, 20h51

Bonjour,
J'ai cru comprendre que tu travaillais avec une liste nommée Liste1 se trouvant dans la feuille nommée [Stages]
Voici donc un code qui filtre et effectue la copie de la ligne total

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 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:=4, Criteria1:=">=10/01/2012", Operator:=xlAnd
  .AutoFilter Field:=5, Criteria1:="<=03/31/2013", Operator:=xlAnd
  .AutoFilter Field:=2, Criteria1:=">=27000"
  End With
 .TotalsRowRange.Copy
 End With

Il reste à coller

Code :

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

.TotalsRowRange.Copy [Destination]

[Destination] doit contenir shtTo.Range("Adresse")

**gFZT82** · 12/05/2013, 09h21

@ Graphikris
Le code fonctionne correctement avec Excel 2007. Je suppose donc qu’il s’agit d’une particularité d’Excel 2003. Tu peux essayer le code suivant qui utilise un format de filtre identique à celui des cellules ("mm/dd/yy").

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
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/yy"), Operator:=xlAnd
    WsS.Range("A1:F1").AutoFilter Field:=5, Criteria1:="<=" & Format(LaDate2, "mm/dd/yy"), 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.ShowAllData
    Sheets("Etat numerique 2013").Select
    Range("D9").Select
    Set WsC = Nothing: Set WsS = Nothing
End Sub

Une autre solution pour éviter la sensibilité au format date de tes cellules

Code :

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

1
2
    WsS.Range("A1:F1").AutoFilter Field:=4, Criteria1:=">=" & LaDate1 * 1, Operator:=xlAnd
    WsS.Range("A1:F1").AutoFilter Field:=5, Criteria1:="<=" & LaDate2 * 1, Operator:=xlAnd

@ Daniel.C
Effectivement, dans ce cas précis on peut utiliser directement la chaine de caractères correspondant au format des cellules pour le critère des filtres mais le fait d’utiliser des variables intermédiaires permet plus de souplesse dans le choix des solutions.

Cordialement

**graphikris** · 12/05/2013, 12h10

Bonjour Philippe T,

Merci pour le code que je viens d'essayer mais au lieu de me copier uniquement le sous total de l'indice des 27000 sur la feuille "Etat Numerique 2013" en F11, le code me copie l'integralité de la ligne Total.

Je suppose que le hic viens d'ici : TotalsRowRange où l'on devrait spécifier

Code :

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

=SOUS.TOTAL(109;F2:F23)

Cordialement,
Graphikris

Bonjour Daniel,

Merci pour le code mais le souci c'est que le sous total ne se copie pas.

**Philippe Tulliez** · 12/05/2013, 12h26

Bonjour,
ListOject.TotalsRowRange renvoie un objet range qui représente la ligne de total de la liste
Dans cette ligne de code MsgBox .TotalsRowRange.Address on renvoie l'adresse de cette ligne.
Donc si tu souhaites ne copier que la dernière cellule de la dernière ligne il faut rectifier l'adresse avec les propriétés Offset et Resize
La ligne a rectifiée

Code :

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

.TotalsRowRange.Offset(, 5).Resize(1, 1).Copy

Comme le nombre de colonnes de la liste peut varier et que l'on souhaite que l'application soit pérenne, il y a lieu d'utiliser une autre propriété ListColumns.Count qui donnera le nombre de colonnes de la liste.
Ce qui donnera

Code :

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

.TotalsRowRange.Offset(, .ListColumns.Count - 1).Resize(1, 1).Copy

**Daniel.C** · 12/05/2013, 12h54

Bonjour,

Merci pour le code mais le souci c'est que le sous total ne se copie pas.

Bon, mais tu m'avais demandé un exemple de filtre (le code plantait) :

Chez moi çà bug, peux tu me joindre un fichier exemple ,stp

Le fichier servait d'exemple pour un filtre sur les dates, pas plus.

**graphikris** · 12/05/2013, 13h25

Envoyé par Philippe Tulliez

Bonjour,
ListOject.TotalsRowRange renvoie un objet range qui représente la ligne de total de la liste
Dans cette ligne de code MsgBox .TotalsRowRange.Address on renvoie l'adresse de cette ligne.
Donc si tu souhaites ne copier que la dernière cellule de la dernière ligne il faut rectifier l'adresse avec les propriétés Offset et Resize
La ligne a rectifiée

Code :

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

.TotalsRowRange.Offset(, 5).Resize(1, 1).Copy

Comme le nombre de colonnes de la liste peut varier et que l'on souhaite que l'application soit pérenne, il y a lieu d'utiliser une autre propriété ListColumns.Count qui donnera le nombre de colonnes de la liste.
Ce qui donnera

Code :

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

.TotalsRowRange.Offset(, .ListColumns.Count - 1).Resize(1, 1).Copy

Encore un grand merci Philippe,

J'ai testé les 2 codes mais encore un souci.
LA COLONNE INDICE ne represente pas un chiffre mais un texte.
J'ai donc modifié le code de :

Code :

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

.AutoFilter Field:=2, Criteria1:=">=25373"

en :

Code :

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

.AutoFilter Field:=2, Criteria1:="25373"

Le tri se passe bien mais pb au niveau du collage.
Si par exemple je prends l'indice 25373, normalement le sous total represente 18 jours de stage.
Dans la feuille Etat Num..., en F19 devrait venir se coller le chiffre 18 mais j'obtiens : #Ref, je peux observer dans la barre de formule, qu' Excel a copier ceci :

Code :

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

=SOUS.TOTAL(109;#REF!)

Normalement Excel devrait mettre F2:F23 au lieu de #Ref

Cordialement,
Graphikris.

**Daniel.C** · 12/05/2013, 13h39

En puisant dans les codes de gFZT82 et de Philippe Tulliez (par ordre d'entrée en scène) :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
    Dim Tablo
    With Sheets("Etat numerique 2013")
        Tablo = Application.Transpose(.Range(.[A11], .Cells(.Rows.Count, 1).End(xlUp)))
    End With
 
    With Sheets("Stages").ListObjects("Liste1")
        .DataBodyRange.AutoFilter 4, ">=10/01/2012"
        .DataBodyRange.AutoFilter 5, "<=03/31/2013"
        For i = 1 To UBound(Tablo)
            .DataBodyRange.AutoFilter 2, Tablo(i)
            Sheets("Etat numerique 2013").Range("F10").Offset(i) = .TotalsRowRange(6).Value
        Next i
    End With

**graphikris** · 12/05/2013, 13h53

Merci Daniel,
Mais mon souci est toujours le meme, le tri par indice ne se realise pas, çà me colle la somme totale : 44 de F11 à F19 sur la feuille Etat num.....

Cordialement

**Philippe Tulliez** · 12/05/2013, 14h13

Bonjour Daniel,

En puisant dans les codes de gFZT82 et de Philippe Tulliez (par ordre d'entrée en scène) :

Une entrée coté cour et l'autre coté jardin.

Bonjour graphikris

Le tri se passe bien mais pb au niveau du collage.
Si par exemple je prends l'indice 25373, normalement le sous total represente 18 jours de stage.
Dans la feuille Etat Num..., en F19 devrait venir se coller le chiffre 18 mais j'obtiens : #Ref, je peux observer dans la barre de formule, qu' Excel a copier ceci :

Oui, c'est vrai qu'au début, comme Daniel, je m'étais concentré sur la partie filtre et pas la partie collage.
Et ma réponse

Il reste à coller

Code :

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

.TotalsRowRange.Copy [Destination]

[Destination] doit contenir shtTo.Range("Adresse")

était un peu rapide sans avoir relu l'ensemble du poste.

Dans ce cas là, il faut faire un collage spécial Valeur pour obtenir la valeur au lieu de la formule.
Donc en rouge la ligne à ajouter. Attention que j'ai mis comme adresse F20 mais c'est tout à fait arbitraire. Je pense qu'avec cela tu peux l'adapter à ton cas.

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
 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:=4, Criteria1:=">=10/01/2012", Operator:=xlAnd
  .AutoFilter Field:=5, Criteria1:="<=02/05/2013", Operator:=xlAnd
  .AutoFilter Field:=2, Criteria1:=">=27000"
  End With
  .TotalsRowRange.Offset(, .ListColumns.Count - 1).Resize(1, 1).Copy
 End With
 shtTo.Range("F20").PasteSpecial xlPasteValues

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

Macros et VBA Excel

Discussions similaires

Partager

Partager