Discussion :

[Charlesraheb]

Bonjour,

Je souhaite automatiser les etapes suivantes:

- Faire un copier coller automatique de la feuille 1 ligne 12 vers la feuille 2 colonne U selon la valeur saisie dans la feuille 2, B1:B3 (Filtre)
- Adapter le range du graph afin que celui ne considere pas les cellules vides a l’issue du filtrage

Voila pour le code que j’essaie d’adapter en vain

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
Sub Worksheet_Change(ByVal Target As Range)
Const Debut As String = "E10"                       'Adapte l'adresse de la première cellule des nom
Dim n As Integer
Dim c As Range
 
Application.ScreenUpdating = False
If Not Intersect(Target, Range("D1:D3")) Is Nothing Then
    UsedRange.EntireColumn.Hidden = False
    n = UsedRange.Columns.Count - Range(Debut).Column + 1
    If n > 0 Then                                  'Par précaution
    i = 0
    Sheets("sheet2").Range("C3:C203").Clear
        For Each c In Range(Debut).Resize(1, n)
            'c.EntireColumn.Hidden = (c <> Range("D1") And Range("D1") <> "") Or (c.Offset(1, 0) <> Range("D2") And Range("D2") <> "") Or (c.Offset(5, 0) <> Range("D3") And Range("D3") <> "")
             If (UCase(c) <> UCase(Range("D1")) And Range("D1") <> "") Or (UCase(c.Offset(1, 0)) <> UCase(Range("D2")) And Range("D2") <> "") Or (c.Offset(5, 0) <> Range("D3") And Range("D3") <> "") Then
             Else
             i = i + 1
             Sheets("sheet2").Range("C3").Offset(i).Value = c.Value
             End If
        Next c
    End If
    'Range("B1:C1").EntireColumn.Hidden = True
End If
End Sub

Merci beaucoup pour l’aide

A+