Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Affichage DIALOGSHEET; ou LISTBOX??

Affichage DIALOGSHEET; ou LISTBOX??

2 réponses
Avatar
S3com
Bonjour,

J'ai une id=E9e si quelqu'un peut m'aider peut etre quel verra le jour!

Je souhaterais pouvoir afficher une liste a selection multiple qui
permettrait de selectionner les feuilles.
Puis de recopier certaines informations de ces feuilles sur une
nouvelle feuille appeler "recap"

comment faire=20

merci
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
JB
Bonjour,

http://cjoint.com/?drrlH6T0FR

Sub auto_open()
For i = 1 To Sheets.Count
If Sheets(i).Name Like "Feuil*" Then
Sheets(1).ListeFeuilles.AddItem Sheets(i).Name
End If
Next i
Sheets(1).ListeFeuilles.MultiSelect = fmMultiSelectMulti
End Sub

Sub resultat()
For i = 0 To Sheets(1).ListeFeuilles.ListCount - 1
If Sheets(1).ListeFeuilles.Selected(i) = True Then
nf = Sheets(1).ListeFeuilles.List(i)
Sheets(nf).Range("A2").CurrentRegion.Offset(1, 0).Copy
Sheets("recap").[A65000].End(xlUp).Offset(1, 0).PasteSpecial '
si formules
End If
Next
End Sub

Cordialement JB
Avatar
Swoap
Merci beaucoup pour votre réponse!!!

J'ai compris le fonctionnement en partie...
Une macro qui permet d'affecter a la liste les noms des onglets et une autre
pour renvoyer les infos.
Je me permet de vous poser une question vis a vis du renvoi . j'ai déjà une
macro qui renvoyait toute une série d'informations, grace a cette listbox je
peux selectionner les feuilles que je veux vraiment, mais j'avoue que j'ai
un peu de mal a adapter ma macro sur la macro resultat.

Vous allez certainement rire car ca doit etre tres "ARTISANALE" mais je suis
novice alors j'essai.
Merci d'avance et bon week end a vous

Cordialement
Emeric
Sub SOMMAIRE_LIST_FRS()
.....

'-----copie valeur cellule/feuille
With Sheets(1)
For ong = 3 To Sheets.Count
.Select
.Cells(ong - 1, 1).Value = Sheets(ong).[E4].Text
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(ong - 1, 2), _
Address:="", SubAddress:=Sheets(ong).Name & "!A1", _
TextToDisplay:=Sheets(ong).Name
.Cells(ong - 1, 3).Value = Sheets(ong).[A8].Text
' Copie Téléphone Siège
.Cells(ong - 1, 4).Value = Sheets(ong).[B8].Text
' Copie E-mail Representant 1
.Cells(ong - 1, 5).Value = Sheets(ong).[D8].Text
' Copie E-mail Representant 2
.Cells(ong - 1, 6).Value = Sheets(ong).[B2].Text
' Copie Nom Representant 1
.Cells(ong - 1, 7).Value = Sheets(ong).[D4].Text
' Copie Nom Representant 2
.Cells(ong - 1, 8).Value = Sheets(ong).[E13].Value
' Copie CA
.Cells(ong - 1, 9).Value = Sheets(ong).[E70].Value
' Copie FACTURE salon
If Cells(ong - 1, 9).Value = 0 Then
.Cells(ong - 1, 9).Value = Sheets(ong).[E71].Value
' Copie FACTURE salon
End If
.Cells(ong - 1, 10).Value = "=RC[-2]*RC[-1]"
' Copie valeur salon
.Cells(ong - 1, 11).Value = Sheets(ong).[E50].Value
' Copie MEA
.Cells(ong - 1, 12).Value = "=RC[-2]*RC[-1]"
' Copie valeur Mea
.Cells(ong - 1, 13).Value = Sheets(ong).[E52].Value
'copie prospectus
.Cells(ong - 1, 14).Value = "=RC[-2]*RC[-1]"
' Copie valeur Prospectus
.Cells(ong - 1, 15).Value = Sheets(ong).[E54].Value
' Copie PAckage Evenementiel
.Cells(ong - 1, 16).Value = "=RC[-2]*RC[-1]"
' Copie valeur pack eve
.Cells(ong - 1, 17).Value = Sheets(ong).[E55].Value
' Copie Prestation logistique
.Cells(ong - 1, 18).Value = "=RC[-2]*RC[-1]"
' Copie valeur prestlog
.Cells(ong - 1, 19).Value = Sheets(ong).[E68].Value
' Copie Precomerch.
.Cells(ong - 1, 20).Value = "=RC[-2]*RC[-1]"
' Copie valeur precomerch
.Cells(ong - 1, 21).Value = Sheets(ong).[E69].Value
' Copie Stats SCA.
.Cells(ong - 1, 22).Value = "=RC[-2]*RC[-1]"
' Copie valeur stats
Next ong
End With

"JB" a écrit dans le message de news:

Bonjour,

http://cjoint.com/?drrlH6T0FR

Sub auto_open()
For i = 1 To Sheets.Count
If Sheets(i).Name Like "Feuil*" Then
Sheets(1).ListeFeuilles.AddItem Sheets(i).Name
End If
Next i
Sheets(1).ListeFeuilles.MultiSelect = fmMultiSelectMulti
End Sub

Sub resultat()
For i = 0 To Sheets(1).ListeFeuilles.ListCount - 1
If Sheets(1).ListeFeuilles.Selected(i) = True Then
nf = Sheets(1).ListeFeuilles.List(i)
Sheets(nf).Range("A2").CurrentRegion.Offset(1, 0).Copy
Sheets("recap").[A65000].End(xlUp).Offset(1, 0).PasteSpecial '
si formules
End If
Next
End Sub

Cordialement JB