Creation onglet et copie donnees

Bonjour tout le monde,

J'ai un fichier qui fait plusieurs milliers de lignes.

Je désire éclater ce fichier en plusieurs onglets.

Je désire créer des onglets en fonction des données dans la colonne "Code" . Premier piège la colonne "Code" peut changer d'emplacement suivant la génération du fichier qui est fait au début.

J'ai déjà fait un code, mais il fonctionne pas du tout et j'ai tout supprimé.

J'avais fait un tableau croisé dynamique dans un nouveau onglet et pensais pouvoir créer les onglets automatiquement et après copier les lignes de la Feuil1 dans chaque onglet, mais impossible...

Suis je assez explicite ?

Merci de votre aide

Christophe

Bonjour et bienvenue,

Peux-tu préciser ta version Excel et nous dire si tu disposes de Récupérer et transformer (Power Query) ?

Cdlt.

Bonjour,

Une piste avec les commentaires dans le code :

Sub CopieFiltre()

    Dim Dico As Object
    Dim Cle As Variant
    Dim Plage As Range
    Dim Cel As Range
    Dim Critere As String
    Dim Col As Integer
    Dim I As Integer

    Set Dico = CreateObject("Scripting.Dictionary")

    With Worksheets("Feuil1")

        'défini la plage sur le tableau (de C5 à Fx)
        Set Plage = .Range(.Cells(5, 3), .Cells(Rows.Count, 6).End(xlUp))

        'recherche le mot "code"...
        Set Cel = Plage.Rows(1).Find("code", , xlValues, xlWhole)

        'si pas trouvé, fin !
        If Cel Is Nothing Then Exit Sub

        '...pour connaître le numéro de colonne et calcule le décalage
        Col = Cel.Column - (Cel.Column - Plage.Columns.Count)

        'parcours la colonne où se trouve le mot "code" sans prendre ce dernier en considération
        For Each Cel In Plage.Columns(Col).Cells.Offset(1).Resize(Plage.Rows.Count - 1)

            'dédoublonne
            Dico(Cel.Value) = Cel.Value

        Next Cel

        'crée les différentes feuilles, les nomme comme le critère et copie le filtrage
        For Each Cle In Dico.Keys

            Worksheets.Add , Sheets(Sheets.Count)

            ActiveSheet.Name = Cle

            Plage.AutoFilter Col, "=" & Cle

            .AutoFilter.Range.EntireRow.Copy ActiveSheet.Cells(1, 1)

            Plage.AutoFilter

        Next Cle

    End With

End Sub

Bonjour,

La version est 365..

Non je n'ai pas Power Query

Christophe

Bonsoir à tous,

Une variante :

Option Explicit
Sub test()
Dim a, e, col, dico As Object, wsName As String
    Application.ScreenUpdating = False
    Set dico = CreateObject("Scripting.Dictionary")
    With Sheets("Feuil1")
        With .Range("c5").CurrentRegion
            col = Application.Match("code", .Rows(1), 0)
            a = .Columns(col).Offset(1).Resize(.Rows.Count - 1).Value
            For Each e In a
                If Not dico.exists(e) Then
                    dico(e) = Empty
                    wsName = e
                    If Not Evaluate("isref('" & wsName & "'!a1)") Then
                        Sheets.Add(after:=Sheets(Sheets.Count)).Name = wsName
                    End If
                    Sheets(wsName).Cells.Delete
                    .AutoFilter col, e
                    .SpecialCells(xlCellTypeVisible).Copy Sheets(wsName).Cells(1)
                    .AutoFilter
                End If
            Next
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonsoir Clegal, le forum,

Tu a écrit :

La version est 365..

mais à droite de ton message :

pour mettre à jour tes infos de config en changeant 360 en 365 : en haut de ton écran à droite, clique sur ton pseudo Clegal et choisis « Panneau de l'utilisateur », puis l'onglet « Profil » : c'est là ! et si tu as Office 365, alors c'est que tu dois utiliser Excel 2016 (car c'est la toute dernière version).

pour la suite, n'oublie pas de lire la réponse de Klin89 : https://forum.excel-pratique.com/viewtopic.php?p=662346#p662346

dhany

Bonjour,

Merci pour votre aide à tous.

Un très grand merci à Klin89.

Ton code est super