[VBA] Transfert vers plusieurs onglet

Bonjour à tous,

Je me fais en ce moment un listing de mes albums musiques et j'aurais encore besoin de vos service, je vous explique :

J'ai créer un classeur Excel avec plusieurs onglets de 0-9 à Z

j'ai un dernier onglet qui s'appel "Nouveaux albums", dans cette onglet je rentre les nouveaux albums que j'ai en ma possession.

je voudrais à l'aide d'un bouton que ces albums soit transférer dans les lettres correspondant, mais je ne veux pas juste que ce soit la cellule qui contient le nom de l'album mais la ligne entière et faire un tri automatique de toutes les lignes.

Est-ce que quelqu'un pourrait m'aider s'il vous plaît

Bonne journée

PS : dans l'onglet "Nouveaux Albums" je rentre j'écris dans la colonne B, car la colonne A il y a une formule automatique qui transfère vers d'autres classeurs

Bonjour,

Merci de joindre un fichier pour une aide adaptée du forum.

Cdlt.

bonjour,

c'est fait désolé

Bonjour willy95, Bonjour Jean-Eric

il manque la feuille X

Sub AJOUTER()

Set plage = Range("A" & Rows.Count).End(xlUp).CurrentRegion
nbcol = plage.Columns.Count - 1
For i = 1 To plage.Rows.Count
    initiale = Left(plage.Cells(i, 2), 1)

    With Sheets(initiale)
        plage.Cells(i, 2).Resize(1, nbcol).Copy Destination:=.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
        With .Sort
            .SetRange Sheets(initiale).Range("A1").CurrentRegion
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

Next

End Sub

Bonjour,

Une autre proposition et un peu de concurrence !...

Cdlt.

Public Sub CopyNewAlbums()
Dim ws As Worksheet
Dim Rng As Range, Cell As Range
Dim lastRow As Long
Dim firstCharacter
    Application.ScreenUpdating = False
    With ActiveSheet
        lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        Set Rng = .Cells(1, 2).Resize(lastRow)
    End With
    For Each Cell In Rng
        firstCharacter = Left(Cell.Value, 1)
        If IsNumeric(firstCharacter) Then
            Set ws = Worksheets("0-9")
        Else
            Set ws = Worksheets(firstCharacter)
        End If
        With ws
            lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(lastRow, 1).Value = Cell.Value
            .Cells(1).CurrentRegion.Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlNo
            .Cells(1).EntireColumn.AutoFit
        End With
    Next Cell
End Sub

Bonsoir Steelson,

Déjà je voulez vous remercier tout les deux pour vos codes (moi j'y comprend rien)

Je n'ai de feuille X

- Le transfert marche bien, par contre je sais pas pourquoi il y a "x" dans la colonne A ?

Quand il transfert dans les colonnes A, j'ai un autre code VBA, qui me transfert dans d'autres classeurs automatiquement, mais maintenant il ne le fais plus (c'est juste la colonne A), c'est pour ca que dans "Nouveau Albums" je commence a la colonne B.

le code VBA est dans "ThisWorkbook", y aurait-il un moyen pour les rassembler

Je vous mets le fichier

Bonjour,

Une autre proposition et un peu de concurrence !...

Cdlt.

17fichiers-test.xlsm (108.39 Ko)

Public Sub CopyNewAlbums()
Dim ws As Worksheet
Dim Rng As Range, Cell As Range
Dim lastRow As Long
Dim firstCharacter
    Application.ScreenUpdating = False
    With ActiveSheet
        lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        Set Rng = .Cells(1, 2).Resize(lastRow)
    End With
    For Each Cell In Rng
        firstCharacter = Left(Cell.Value, 1)
        If IsNumeric(firstCharacter) Then
            Set ws = Worksheets("0-9")
        Else
            Set ws = Worksheets(firstCharacter)
        End If
        With ws
            lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(lastRow, 1).Value = Cell.Value
            .Cells(1).CurrentRegion.Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlNo
            .Cells(1).EntireColumn.AutoFit
        End With
    Next Cell
End Sub

Merci pour ton code, mais il ne transfert que les éléments inscrit dans la colonne A et pas les autre lignes

willy95 a écrit :

- Le transfert marche bien, par contre je sais pas pourquoi il y a "x" dans la colonne A ?

J'ai juste voulu simuler quelque chose dans la colonne A et vérifier que la macro fonctionne correctement sans copier A ! ... si j'ai bien pigé ! sinon dis moi ce qu'il faut modifier.

Toujours ok Jan-Eric pour une saine émulation et des propositions alternatives !

Ah ok donc je te confirme que la macro fonctionne très bien

Maintenant il reste l'autre parti

Merci

Bonjour Willy,

je n'ai pas compris ce qu'il restait ?

Bonjour,

J'ai regardé ma proposition, et il me semble bien quelle répond à la demande.

Copier les éléments de la colonne B dans chaque onglet en fonction du premier caractère et effectuer un tri ascendant.

J'ai affiné un peu pour les chiffres de 0 à 9.

Cdlt.

Bonjour Willy,

je n'ai pas compris ce qu'il restait ?

Bonjour,

Quand il transfert dans les colonnes A, j'ai un autre code VBA, qui me transfert dans d'autres classeurs automatiquement, mais maintenant il ne le fais plus (c'est juste la colonne A), c'est pour ça que dans "Nouveau Albums" je commence a la colonne B.

C'est a dire qu'avant quand j’écrivais dans les colonne A a la suite de mes albums, quand je validais il me transferait automatiquement la cellule A dans un autre classeur.

le code VBA est dans "ThisWorkbook" c'est GMT qui me l'avais fait. Mais maintenant il doit y avoir conflit avec les 2 codes donc j'ai supprimer son code.

- Je reviens vers toi pour X dans les colonnes A, j'ai bien compris que c’était un test, mais suis-je obliger de le laisser, car si je les enlève le code ne marche pas.

willy95 a écrit :

le code VBA est dans "ThisWorkbook" c'est GMT qui me l'avais fait. Mais maintenant il doit y avoir conflit avec les 2 codes donc j'ai supprimer son code.

Je n'ai trouvé aucune autre macro dans ton fichier, donc merci de le mettre à jour je regarderai les interférences

merci si tu peux regarder

je te mets le fichiers, la macro a été mise dans "ThisWorkbook"

willy95

Qu'est-ce qu'elle est sensée faire la macro ? Quelle est ton intention ?

La macro est activée à chaque changement d'un onglet :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

avec

    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A:A")) Is Nothing Then

or tu demandes de transférer toute une ligne commençant e B dans un onglet ... donc Target.count sera toujours supérieur à 1 et entraînera alors la sortie de cette sub

Ce que je veux qu'il me fasse si c'est possible

quand je lance ta macro, quelle fasse ce qu'elle fait, et après dans les lettres ou il des nouvelles (dans les colonnes A) de nouveau albums inscrit les transférer dans des classeurs différents.

En resumé :

j'ai un dossier ALBUMS

et d'autres dossiers ALBUMS A, B, C

Je voudrais que dans ALBUMS, les colonnes A ou j'ai ajouter des albums (ta macro), soit transférer dans les ALBUMS A, B, C. avec une nuance c'est de mettre en orange les onglets qui sont modifier dans ALBUMS A, B, C, avec un tri automatique. c'est la macro que ma faite GMB.

J’espère avoir été claire ? Mais ta macro me va nickel sinon.

ok, mais je n'ai pas envie de refaire le travail de GMT (ou gmb ?), ce ne serait pas "fair" de ma part, essaie de voir avec lui !

Non c'est pas ce que je veux non plus, ça macro est nickel, je voulais juste savoir s'il y avait le possibilité des les liés

tu vois d'abord lancer ta macro, et après lancé la sienne, je sais pas si ça ce fait ça ?

Essaie en enlevant cette ligne

If Target.Count > 1 Then Exit Sub

mais je crains un peu l'enchainement des instructions.