Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 Ajouter sur quatre feuilles

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion maval
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

maval

XLDnaute Barbatruc
Bonjour

J'ai dans une feuille une liste de 3 noms dans la cellule "E", j'ai un code qui sépare les trois noms et qui les transposes dans la colonne "A" jusqu'ici tous vas bien.
J'aimerais que lorsque j'ajoute dans la feuille nommé "Données" une liste de 3 noms dans une des cellule "E" sa les ajoute dans les quatre feuilles "BdD Acteurs, Filmographie, Récompenses, Biographie" dans la colonne "A"

Si possible?

Je vous remercie d'avance
 

Pièces jointes

Trier par date Trier par votes
Re : Ajouter sur quatre feuilles

Bonjour, maval, le Forum,

Comme ceci ?

Code: 
Sub Séparer()
    Dim Cel As Range
    Dim DEST As Range
    Dim o As Object    ' ajouter
    Application.ScreenUpdating = False
    For Each Cel In Range("E2:E" & Cells(Application.Rows.Count, 5).End(xlUp).Row)
        If UBound(Split(Cel.Value, ",")) > 0 Then
            For i = 0 To UBound(Split(Cel.Value, ","))
                Set DEST = IIf(Range("A2") = "", Range("A2"), Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
                DEST.Value = Trim(Split(Cel.Value, ",")(i))
            Next i
        Else
            For i = 0 To UBound(Split(Cel.Value, ";"))
                Set DEST = IIf(Range("A2") = "", Range("A2"), Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
                DEST.Value = Trim(Split(Cel.Value, ";")(i))
            Next i
        End If
    Next Cel
    ' ajouter
    For Each o In Worksheets(Array("BdD Acteurs", "Filmographie", "Récompenses", "Biographie"))
        Sheets("Données").Columns(1).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy Destination:=o.Range("a1")
    Next
    Application.ScreenUpdating = True
End Sub

A bientôt 🙂
 
Vote positif 0 Vote négatif
Re : Ajouter sur quatre feuilles

Bonjour Doublezero,

Je te remercie beaucoup seul bémol c'est que sa recopie à chaque fois toute la liste, alors qu'il serai bien qu'il rajoute uniquement les noms ajoutés à la colonne "E"

A bientôt
 
Vote positif 0 Vote négatif
Re : Ajouter sur quatre feuilles

Re-bonjour,

maval à dit:
... sa recopie à chaque fois toute la liste, alors qu'il serai bien qu'il rajoute uniquement les noms ajoutés à la colonne "E"...
Cliquez pour agrandir...

Certes... Mais c'est le produit de la macro originale pour l'onglet "Données" (copie des valeurs les unes sous les autres, sans suppression préalable).

Nouvel essai :

Code: 
Sub Séparer_v2()
    Dim Cel As Range
    Dim DEST As Range
    ' ajouter
    Dim o As Object
    Application.ScreenUpdating = False
    ' ajouter
    Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row).Clear
    For Each Cel In Range("E2:E" & Cells(Application.Rows.Count, 5).End(xlUp).Row)
        If UBound(Split(Cel.Value, ",")) > 0 Then
            For i = 0 To UBound(Split(Cel.Value, ","))
                Set DEST = IIf(Range("A2") = "", Range("A2"), Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
                DEST.Value = Trim(Split(Cel.Value, ",")(i))
            Next i
        Else
            For i = 0 To UBound(Split(Cel.Value, ";"))
                Set DEST = IIf(Range("A2") = "", Range("A2"), Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
                DEST.Value = Trim(Split(Cel.Value, ";")(i))
            Next i
        End If
    Next Cel
    ' ajouter
    For Each o In Worksheets(Array("BdD Acteurs", "Filmographie", "Récompenses", "Biographie"))
        Sheets("Données").Columns(1).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy Destination:=o.Range("a1")
    Next
    Application.ScreenUpdating = True
End Sub

A bientôt 🙂
 
Vote positif 0 Vote négatif
Re : Ajouter sur quatre feuilles

Re,

Oui sa roule, je vais t'embêter un petit peu si tu le permet je viens de m'apercevoir si cela est possible de mettre la liste en ordre alpha et supprimer les doublons SVP.
Je te remercie et te souhaite un bon WE
 
Vote positif 0 Vote négatif
Re : Ajouter sur quatre feuilles

Re-bonjour,

Une nouvelle version...

Code: 
Sub Séparer_v3()
    Dim Cel As Range
    Dim DEST As Range
    ' ----------------------------------------------- ajouter
    Dim o As Object
    Application.ScreenUpdating = False
    ' ----------------------------------------------- ajouter
    Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row).Clear
    For Each Cel In Range("E2:E" & Cells(Application.Rows.Count, 5).End(xlUp).Row)
        If UBound(Split(Cel.Value, ",")) > 0 Then
            For i = 0 To UBound(Split(Cel.Value, ","))
                Set DEST = IIf(Range("A2") = "", Range("A2"), Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
                DEST.Value = Trim(Split(Cel.Value, ",")(i))
            Next i
        Else
            For i = 0 To UBound(Split(Cel.Value, ";"))
                Set DEST = IIf(Range("A2") = "", Range("A2"), Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
                DEST.Value = Trim(Split(Cel.Value, ";")(i))
            Next i
        End If
    Next Cel
    ' ----------------------------------------------- ajouter
    With Range("a:a")
        .RemoveDuplicates Columns:=1, Header:=xlYes
        .Sort Range("a1"), xlAscending, Header:=xlYes
    End With
    For Each o In Worksheets(Array("BdD Acteurs", "Filmographie", "Récompenses", "Biographie"))
        Sheets("Données").Columns(1).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy Destination:=o.Range("a1")
    Next
    Application.ScreenUpdating = True
End Sub

A bientôt 🙂
 
Vote positif 0 Vote négatif
Re : Ajouter sur quatre feuilles

Re,

Je te remercie beaucoup, je vais essayer de me dépatouiller parce que je me suis planter dans la feuille "BdD Acteurs" il était en colonne "B".
Je te remercie et te souhaite un très bon WE
 
Vote positif 0 Vote négatif
Re : Ajouter sur quatre feuilles

Bonjour,

Après avoir essayé de me dépatouiller je n'arrive pas à mettre dans la feuille "BdD Acteurs" il était en colonne "B".

Si quelqu'un passe par là et peut m'aider?
je vous remercie d'avance
 
Vote positif 0 Vote négatif
Re : Ajouter sur quatre feuilles

Bonjour, maval, le Forum,

Version 4 :

Code: 
Sub Séparer_v4()
    Dim Cel As Range
    Dim DEST As Range
    ' ----------------------------------------------- ajouter
    Dim o As Object
    Application.ScreenUpdating = False
    ' ----------------------------------------------- ajouter
    Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row).Clear
    For Each Cel In Range("E2:E" & Cells(Application.Rows.Count, 5).End(xlUp).Row)
        If UBound(Split(Cel.Value, ",")) > 0 Then
            For i = 0 To UBound(Split(Cel.Value, ","))
                Set DEST = IIf(Range("A2") = "", Range("A2"), Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
                DEST.Value = Trim(Split(Cel.Value, ",")(i))
            Next i
        Else
            For i = 0 To UBound(Split(Cel.Value, ";"))
                Set DEST = IIf(Range("A2") = "", Range("A2"), Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
                DEST.Value = Trim(Split(Cel.Value, ";")(i))
            Next i
        End If
    Next Cel
    ' ----------------------------------------------- ajouter
    With Range("a:a")
        .RemoveDuplicates Columns:=1, Header:=xlYes
        .Sort Range("a1"), xlAscending, Header:=xlYes
    End With
    For Each o In Worksheets(Array("Filmographie", "Récompenses", "Biographie"))
        Sheets("Données").Columns(1).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy Destination:=o.Range("a1")
    Next
    Sheets("Données").Columns(1).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Copy Destination:=Sheets("BdD Acteurs").Range("b1")
    Application.ScreenUpdating = True
End Sub

A bientôt 🙂
 
Vote positif 0 Vote négatif
Re : Ajouter sur quatre feuilles

Bonjour,

Suite au code de DoubleZero que je remercie encore j'ai un petit souci au niveau du rangement qui se fait par ordre alpha dans chaque feuille mais les autres colonne ne suive pas il me décale toute les colonnes.
Si quelqu'un passe par là je le remercie d'avance, je joint mon fichier avec les explications.

Bonne journée.
 

Pièces jointes

Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

D
  • Question Question
XL 2021 Boucle sur deux feuilles
Réponses
11
Affichages
237
dadaze
D
  • Question Question
Microsoft 365 créer des feuilles automatiques et une formule avec condition de remplissage
Réponses
2
Affichages
324
luno123
D
  • Résolu(e)
Microsoft 365 Validation de données sous condition
Réponses
8
Affichages
336
drop91
D
M
  • Question Question
XL 2016 Comparaison de 2 listes sur deux onglets différents
Réponses
3
Affichages
303
Michael78
M
E
  • Résolu(e)
Microsoft 365 Combobox ajouter si n'existe pas dans Liste
2 3 4
Réponses
47
Affichages
3 K
cathodique
  • Question Question
XL 2021 Déclaration de variables à partir d'une liste de noms
Réponses
8
Affichages
467
PMG
C
  • Résolu(e)
XL 2016 Automatisation de l'alimentation des cellules de plusieurs feuilles Excel (Formules : Recherchev...)
Réponses
10
Affichages
354
micheldu52
S
  • Question Question
XL 2013 Copier automatiquement des données dans plusieurs onglets
Réponses
4
Affichages
476
Phil69970
B
  • Question Question
XL 2019 Conserver les formules qui sont enregistrées dans des cellules
Réponses
8
Affichages
389
Phil69970
P
  • Question Question
XL 2016 Macro VBA remplissage tableau de synthèse % déchet ligne de production
Réponses
4
Affichages
310
vgendron
A
  • Question Question
XL 2021 listbox
2
Réponses
18
Affichages
502
Dranreb
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
649
piga25
T
  • Question Question
XL 2013 Impression, choix de feuilles et nombre de copie
Réponses
11
Affichages
614
AtTheOne
C
  • Résolu(e)
XL 2021 Userform impression + choix des feuilles
Réponses
8
Affichages
504
candido57
C
J
  • Question Question
Microsoft 365 Copie des onglets dans un fichier séparé depuis une liste en VBA
Réponses
3
Affichages
399
job75
M
  • Question Question
XL 2019 Transposer des données d'une feuille vers une autre sous forme de synthèse
Réponses
8
Affichages
628
mromain
D
  • Résolu(e)
XL 2021 Créer feuilles automatiquement dans un classeur a partir d'une liste et lien hypertexte
Réponses
6
Affichages
682
Phil69970
L
  • Résolu(e)
XL 2016 Pb publipostage conditionnelle avec base de données Excel
Réponses
1
Affichages
503
Linda42
L
J
  • Question Question
Microsoft 365 Ajouter une colonne
Réponses
0
Affichages
500
Juliopapadopulos
J
S
  • Question Question
XL 2016 Différents calculs et graphiques
Réponses
8
Affichages
278
Stephane72
S
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…