Discussion :

[Paloma]

Bonjour,

après avoir passer du temps à faire fonctionner un petit bout de code pour extraire des données de plusieurs onglets dans un seul, j'aimerais savoir s'il est possible de "sauter" un onglet si par exemple une cellule de cet onglet contient l'un des mots "Fermé" ou "Annulé" ?

Je suppose qu'il faudrait faire un test par onglet pour savoir si la cellule est "égale" à "Fermé" ou "Annulé" et si oui je passe à l'onglet suivant, sinon je continu d'exécuter le code et j'extrais les données ... c'est ça?

voici le code

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
Option Explicit
 
Dim f As Worksheet, derCol&, i&, lgn&
 
Sub Import()
 
   Application.ScreenUpdating = False
   Range("A8").CurrentRegion.Offset(1, 0).ClearContents 'On réinitialise le tableau de départ
    i = 7 ' Numero de la 1ere ligne à utiliser
    For Each f In Worksheets
        If f.Name Like "Client*" Then     'Boucle qui permet de passer toutes les feuilles qui contiennent
                                           'le mot "Projet " dans le nom de leur onglet
 
' pour chaque feuille "Client*" je copie les cellules suivantes et je les colle dans l'onglet "Recap" sur une seule ligne et une ligne par onglet Client
 
' ici j'imagine qu'il me faut faire une boucle pour aller d'un onglet Client à un autre (ou le For Each ci-dessus peut-être utilisé ...?):
 
           'Je.parcours.le.premier.onglet jusqu 'au dernier (if?)
 
                           Sheets(f.Name).Select 'activation onglet client*
                           Range("D14").Select 'sélection colonne D14 client*
                           Selection.Copy
                           Sheets("Recap").Select 'activation onglet Recap
                           Range("B" & i).Select 'On donne la lettre de la colonne pour ici cela sera "B" i represente la ligne
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
 
                           Sheets(f.Name).Select 'activation onglet client*
                           Range("I14").Select
                           Selection.Copy
                           Sheets("Recap").Select
                           Range("C" & i).Select
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
 
                           Sheets(f.Name).Select 'activation onglet client*
                           Range("M5:T5").Select
                           Selection.Copy
                           Sheets("Recap").Select
                           Range("D" & i).Select
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
 
                           Sheets(f.Name).Select 'activation onglet client*
                           Range("D27").Select
                           Selection.Copy
                           Sheets("Recap").Select
                           Range("L" & i).Select
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
 
                           Sheets(f.Name).Select 'activation onglet client*
                           Range("M6:T6").Select
                           Selection.Copy
                           Sheets("Recap").Select
                           Range("M" & i).Select
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
 
                            'On incremente la ligne
                            i = i + 1
        End If
    Next f
 
End Sub

[Paloma]

Bon j'ai déjà une idée qui fonctionne ("test à l'envers"):

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
Option Explicit
 
Dim f As Worksheet, derCol&, i&, lgn&
 
Sub Import()
 
'   Application.ScreenUpdating = False
'   Range("A8").CurrentRegion.Offset(1, 0).ClearContents 'On réinitialise le tableau de départ
    i = 7 ' Numero de la 1ere ligne à utiliser
    For Each f In Worksheets
        If f.Name Like "Client*" Then     'Boucle qui permet de passer toutes les feuilles qui contiennent
                                           'le mot "Projet " dans le nom de leur onglet
 
' pour chaque feuille "Client*" je copie les cellules suivantes et je les colle dans l'onglet "Recap" sur une seule ligne et une ligne par onglet Client
 
' ici j'imagine qu'il me faut faire une boucle pour aller d'un onglet Client à un autre (ou le For Each ci-dessus peut-être utilisé ...?):
 
           'Je.parcours.le.premier.onglet jusqu 'au dernier (if?)
 
           Sheets(f.Name).Select 'activation de l'onglet client pour le test
           If Range("B1").Value = "Oui" Then
 
                           Sheets(f.Name).Select 'activation onglet client*
                           Range("D14").Select 'sélection colonne D14 client*
                           Selection.Copy
                           Sheets("Recap").Select 'activation onglet Recap
                           Range("B" & i).Select 'On donne la lettre de la colonne pour ici cela sera "B" i represente la ligne
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
 
                           Sheets(f.Name).Select 'activation onglet client*
                           Range("I14").Select
                           Selection.Copy
                           Sheets("Recap").Select
                           Range("C" & i).Select
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
 
                           Sheets(f.Name).Select 'activation onglet client*
                           Range("M5:T5").Select
                           Selection.Copy
                           Sheets("Recap").Select
                           Range("D" & i).Select
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
 
                           Sheets(f.Name).Select 'activation onglet client*
                           Range("D27").Select
                           Selection.Copy
                           Sheets("Recap").Select
                           Range("L" & i).Select
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
 
                           Sheets(f.Name).Select 'activation onglet client*
                           Range("M6:T6").Select
                           Selection.Copy
                           Sheets("Recap").Select
                           Range("M" & i).Select
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
 
                            'On incremente la ligne
                            i = i + 1
                Else
 
            End If
        End If
    Next f
 
End Sub

A voir si je peux cumuler deux tests ("si annulé ou si fermé")...

[BENNASR]

bonjour
une piste peut etre

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Sub Test()
    Dim Sh As Worksheet
       i = 1
    For Each Sh In Worksheets
        If Sh.Cells(1, 1) <> "cloture" Or Sh.Cells(1, 1) <> "annulé" Then
        Sheets("feuil1").Cells(i, 1) = Sh.Cells(2, 1)
        End If
        i = i + 1
    Next Sh
End Sub