XL 2016 VBA pour sélectionner feuilles indiqué dans une cellule

[sebastien34]

bonjour a tous,
je galère sur un code VBA depuis plusieurs semaines.
je souhaiterais sélectionner automatiquement plusieurs feuilles dont le nom est indiqué dans la colonne D de mon exemple.
cela me permettra de les combiner par la suite dans un PDF pour l'envoie par email.

si quelqu'un a une idée, je suis preneur!
bonne journée a tous

 

[Lolote83]

Bonjour,
Voici ton fichier en retour
Faire la sélection en colonne B avec des x comme dans ton exemple et clic sur le bouton. Les feuilles marquées d'un x seront sélectionnées
Attention, pour que cela fonctionne bien il a fallu renommer la feuille Semaine en Semaine (1)
@+ Lolote83

 

[sousou]

bonjour
Se code selectionne les feuilles nommé dans la sélection.
Attention dans ton fichier à l'espace entre semaine et ()
Il faut de la cohérence dans l'écriture semaine(1) n'est pas semaine (1)
Sub deb()
Dim table()
ReDim table(1 To Selection.Count)

For n = 1 To UBound(table)
For Each f In Sheets
If f.Name = Selection.Rows(n) Then
table(n) = f.Index
End If
' MsgBox f.Name
Next
Next
Sheets(table).Select

End Sub

 

[Phil69970]

Bonjour à tous

Ma version avec une remarque comme @Lolote83 et @sousou

Il faut de la cohérence dans l'écriture semaine(1) n'est pas semaine (1)

J'en ai profité (pour le fun) pour faire un renommage automatique de tes feuilles et de pouvoir revenir à la situation antérieur 😉


Merci de ton retour

 

[sebastien34]

Merci Phil69970,
Effectivement il y a un espace ,je n'avait pas fait attention en recopiant la feuille.
je ne peux pas renommer les onglets car le document compote 76 feuilles lié entre elle.

 

[Phil69970]

Re

Qu'à cela tienne
J'ai supprimé les macros de renommage et je te propose la V2
Merci de ton retour

 

[sebastien34]

Nickel, merci beaucoup Phil69970.
je mets le code terminé complet pour sélection des feuilles et envoie par email.

Function WsExist(Nom$) As Boolean
On Error Resume Next
WsExist = Sheets(Nom).Index
End Function

Sub Multiselect()
Dim Feuille As Worksheet
For i = 6 To 58
If Range("V" & i) = "x" Then
If WsExist(Range("X" & i)) Then
Sheets(Range("X" & i).Value).Name = Range("X" & i).Value
Sheets(Range("X" & i).Value).Select Replace:=False
End If
End If
Next i


' Ce code permet de générer un PDF à partir d'une feuille et de le joindre à un mail

' Déclaration des variables utilisées dans le code
Dim sPath As String, sFileName As String, ShtName As String
Dim OutApp As Object, OutMail As Object
'
' Initialisation des variables
' Chemin d'accès du dossier TEMP
sPath = Environ("TEMP") & "\"
' Nom du fichier à envoyer par mail
sFileName = Sheets("SIGNALEMENT MENSUEL").Range("A1")
' Vérifier l'extension du fichier à enregistrer
If Right(sFileName, 4) <> ".pdf" Then sFileName = sFileName & ".pdf"
' Nom de la feuille à exporter en PDF
ShtName = "SIGNALEMENT MENSUEL"
'
'
' 1) Générer le PDF dans le répertoir temporaire de l'utilisateur
Sheets(ShtName).ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & sFileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

'
' 2) Créer le mail et joindre le fichier
' Création d'une instance Outlook pour envoyer un mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
' Avec mon objet OutMail
With OutMail
.Display ' Afficher le mail pour afficher la signature
' Destinataire(s) du mail
.To = Sheets("DONNEES").Range("Z3")
' Copie du mail
.CC = Sheets("DONNEES").Range("Z4")
' Sujet de l'OutMail
.Subject = Sheets("DONNEES").Range("Z5")
' Corps du mail avec signature à la fin
.HTMLBody = "Bonjour," & "<BR><BR>" _
& Sheets("DONNEES").Range("Z7") & " " & sFileName & "<BR><BR>" & .HTMLBody
' Joindre le fichier précédemment créé
.Attachments.Add sPath & sFileName
' Envoyer l'OutMail
'.Send
End With
' Effacer les variable objet
Set OutMail = Nothing: Set OutApp = Nothing
' Supprimer le fichier du répertoire temporaire
Kill sPath & sFileName

' désélectionne et revient a l'onglet signalement

Sheets("SIGNALEMENT MENSUEL").Select
End Sub