Discussion :

[Nonno 94]

Bonjour le Forum,

je viens vous demander comment modifier le code ci-dessous qui, actuellement ne sélectionne que la 1 ère de ces 6 feuilles, pour qu'il sélectionne toutes les feuilles dont les noms figurent dans les cellules indiquées.

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 Feuille_sélectionner()
'
' Feuille_sélectionner Macro
'
 
'
    If [AH11] <> "" Then
    Feuil8.Select
    End If
 
    If [AH12] <> "" Then
    Feuil9.Select
    End If
 
    If [AH13] <> "" Then
    Feuil10.Select
    End If
 
    If [AH14] <> "" Then
    Feuil11.Select
    End If
 
    If [AH15] <> "" Then
    Feuil12.Select
    End If
 
    If [AH16] <> "" Then
    Feuil13.Select
    End If
End Sub

Remerciements pour vos réponses.
Bonne journée.
cordialement.

Nonno 94.

[Marc-L]

Bonjour,

pas possible à partir des CodeName des feuilles de calculs mais à partir de leurs noms depuis leurs numéros d'index :

Code :

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

1
2
3
4
5
6
7
8
Sub Demo()
    For R& = 1 To 6
        If Cells(10 + R, 34).Value > "" Then _
            S$ = S$ & IIf(S$ > "", "¤", "") & Worksheets(7 + R).Name
    Next
 
    Worksheets(Split(S, "¤")).Select
End Sub

Merci à l'Enregistreur de macros offrant sur un plateau la solution !

__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[Nonno 94]

Bonjour Marc-L et merci d'avoir pris la peine de me répondre.

Malheureusement, le code que vous proposez ne sélectionne pas les feuilles souhaitées (AREVA, STMICROELECTRONICS et NEXANS) des valeurs sélectionnées dans la colonne "AH" de la feuille "valeurs" mais les feuilles "Synthèse", "Cours Hist 1" et "Cours Hist 3".
J'ai essayé en vain de le modifier. Est-ce possible ?
Je joins le fichier d'essai qui vous permettra, je l'espère, de mieux comprndre mon problème.

Dans l'attente et avec mes remerciements.

Nonno 94.

[Marc-L]

Pas besoin d'ouvrir de pièce jointe pour en déduire l'ordre des feuilles ne correspond pas à l'ordre des CodeName,
dommage !

Utiliser alors l'Enregistreur de macros pour sélectionner plusieurs feuilles manuellement
afin de comprendre comment cela fonctionne …

[PMO2017]

Bonjour,

Essayez le code suivant

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
Sub aa()
Dim R As Range
Dim C As Range
Dim T()
Dim i&
Set R = Sheets("Valeurs").Range("ah11:ah16")
For Each C In R
  If C <> "" Then
    i& = i& + 1
    ReDim Preserve T(1 To i&)
    T(i&) = C
  End If
Next C
Sheets(T).Select
End Sub

[Marc-L]

Autre approche plus simple :

Code :

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

1
2
3
4
5
6
7
Sub Demo()
    For R& = 1 To 6
        S$ = S$ & IIf(Cells(10 + R, 34).Text > "", "¤" & Cells(10 + R, 34).Text, "")
    Next
 
    If S > "" Then Worksheets(Split(Mid(S, 2), "¤")).Select
End Sub

__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[Nonno 94]

Désolé Marc-L mais je ne comprends pas votre réponse !!!

J'ai "écrit" le code suivant et il fonctionne :

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Sélectionner_feuille()
'
' Sélectionner_feuille Macro
'
 
'
If [AH13] <> "" Then
Feuil10.Select
End If
End Sub

[AH13] = ""; la feuille n'est pas sélectionnée.

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Sélectionner_feuille()
'
' Sélectionner_feuille Macro
'
 
'
If [AH11] <> "" Then
Feuil10.Select
End If
End Sub

la feuille 10 est sélectionnée car [AH11] <> "".

Il semble donc que l'on puisse sélectionner des feuilles par leur codename (feuil10) et par leur nom (Alcatel-Lucent).

J'ai par ailleurs, comme vous le suggérez, enregistré la macro suivante :

Code :

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

1
2
3
4
5
6
7
8
9
Sub Macro2()
'
' Macro2 Macro
'
 
'
    Sheets(Array("ALCATEL-LUCENT", "STMICROELECTRONICS", "AREVA")).Select
    Sheets("AREVA").Activate
End Sub

sans en apercevoir l'intérêt pour le problème que j'ai soumis au Forum.

Le dernier code communiqué bloque à ce niveau :

Code :

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

Worksheets(Split(Mid(S, 2), "¤")).Select

Merci pour vos propositions.
Cordialement.

Nonno 94.

Bonjour PMO2017 et merci pour votre proposition de code.

Il fonctionne ....presque et bloque à ce niveau :

Code :

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

Sheets(T).Select

Je ne sais comment le corriger si cela est possible. C'est dommage.

Merci encore.
Cordialement.

Nonno 94

[Marc-L]

[…] sans en apercevoir l'intérêt pour le problème que j'ai soumis au Forum.

Utiliser alors l'Enregistreur de macros pour sélectionner plusieurs feuilles manuellement
afin de comprendre comment cela fonctionne …

L'intérêt est pourtant clairement indiqué mais encore faut-il vouloir se donner la peine de comprendre ‼

Sinon aucun souci de mon côté avec ma proposition comme avec celle de PMO2017 ‼

Désolé … Tout aussi cordialement.

[Nonno 94]

Bonsoir Marc-L,

le "flemmard" qui n'est ni expert ni développeur va tout de même prendre la peine de vous répondre pour vous informer que votre code ainsi que celui de PMO2017 ne fonctionne pas avec "mon fichier" que je vais tout de même joindre même si :

Pas besoin d'ouvrir de pièce jointe pour en déduire

....
Je le déplore sincèrement car dans le cas contraire, j'aurais pu me contenter de vous décerner à tous deux des amplement mérités.

Je vous souhaite à tous deux une EXCEL-lente soirée et vous remercie pour vos propositions.
Très cordialement.

Nonno 94.

[Nonno 94]

Bonjour le Forum,

le Code proposé par PMO2017 fonctionne parfaitement grâce à la perspicacité de casefayere.
Je souhaite maintenant l'utiliser pour en créer 2 nouveaux qui me permettront :
- de sélectionner les feuilles et de colorer leur onglet en rouge
- de sélectionner les feuilles et de les supprimer.

Malheureusement, je ne parviens pas à "adapter et combiner" les codes requis pour obtenir le résultat recherché.
Peut-être y parviendrez-vous ?

Les Codes sont les suivants :
1/ Sélection des feuilles

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
Sub aa()
Dim R As Range
Dim C As Range
Dim T()
Dim i&
Set R = Sheets("Valeurs").Range("ah11:ah16")
For Each C In R
  If C <> "" Then
    i& = i& + 1
    ReDim Preserve T(1 To i&)
    T(i&) = C
  End If
Next C
Sheets(T).Select
End Sub

2/ Onglets Rouges

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
Sub Onglets_Rouges()
'
' Onglets Macro
'
 
'
    Sheets(Array("NEXANS", "STMICROELECTRONICS", "AREVA")).Select
    Sheets("AREVA").Activate
    With ActiveWorkbook.Sheets("AREVA").Tab
        .Color = 255
        .TintAndShade = 0
    End With
    With ActiveWorkbook.Sheets("STMICROELECTRONICS").Tab
        .Color = 255
        .TintAndShade = 0
    End With
    With ActiveWorkbook.Sheets("NEXANS").Tab
        .Color = 255
        .TintAndShade = 0
    End With
    Sheets("Valeurs").Select
End Sub

3/ Suppression des feuilles

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Feuilles_Supprimer()
'
' Feuilles_Supprimer Macro
'
 
'
    Sheets(Array("NEXANS", "STMICROELECTRONICS", "AREVA")).Select
    Sheets("AREVA").Activate
    ActiveWindow.SelectedSheets.Delete
End Sub

Les noms des feuilles qui changent sont dans : Sheets("Valeurs").Range("ah11:ah16")

Avec mes remerciements pour vos propositions et en vous souhaitant une bonne journée.
Cordialement.

Nonno 94.

[PMO2017]

Bonjour,

On remplace la Sub aa par la fonction Selection_Feuilles() As Sheets pour la raison qu'elle est appelée par différentes procédures (virez donc la Sub aa).
Essayez le code suivant

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
Function Selection_Feuilles() As Sheets
Dim R As Range
Dim C As Range
Dim T()
Dim i&
'---
Set R = Sheets("Valeurs").Range("ah11:ah16")
For Each C In R
  If C <> "" Then
    i& = i& + 1
    ReDim Preserve T(1 To i&)
    T(i&) = C
  End If
Next C
'---
Err.Clear
On Error Resume Next
Sheets(T).Select
If Err <> 0 Then
  MsgBox "Certains noms ne correspondent pas à des feuilles existantes"
  Exit Function
Else
  Set Selection_Feuilles = Sheets(T)
End If
End Function
 
Sub Onglets_Rouges()
Dim CollS As Sheets
Dim S As Worksheet
'---
Set CollS = Selection_Feuilles
If Not CollS Is Nothing Then
  For Each S In ActiveWindow.SelectedSheets
    S.Tab.Color = vbRed
  Next S
End If
End Sub
 
Sub Feuilles_Supprimer()
Dim CollS As Sheets
Dim S As Worksheet
'---
Set CollS = Selection_Feuilles
If Not CollS Is Nothing Then
  Application.DisplayAlerts = False
  For Each S In ActiveWindow.SelectedSheets
    S.Delete
  Next S
  Application.DisplayAlerts = True
End If
End Sub
 
Sub Juste_Selectionner()
Dim obj As Object
Set obj = Selection_Feuilles
End Sub

[Nonno 94]

Re PMO2017,

ayant dû faire face à des urgences, je n'ai pu essayer votre dernier code et répondre plu tôt à votre message; ce dont vous voudrez bien m'excuser.
Je m'empresse de le faire aujourd'hui pour vous dire que j'ai suivi votre conseil :

(virez donc la Sub aa)

, intégré les nouvelles dans mon fichier et que désormais tout fonctionne parfaitement.
Je vous renouvelle donc mes remerciements pour votre patience et vous adresse les bien mérités.

Si vous en avez le loisir, vous accepterez peut-être de prendre connaissance de la nouvelle discussion que j'ai ouverte pour m'aider à résoudre le nouveau problème auquel je suis confronté.

http://www.developpez.net/forums/d13...ee-macro-1-er/

Bonne journée.
Cordialement.

Nonno 94.