Tri et Export données par onglet

Bonjour à toutes et tous

J'aimerais créer automatiquement un onglet par item au lieu de le faire manellement, les items peuvent évoluer

Et exporter les données de ces items dans le bon onglet,

Par exemple:

créer un onglet A0 puis remplir l'onglet avec les données commençant par A0

Puis faire la même chose pour les autres onglets

B0, Balancelle 1,2,3 ...TK1, 2 ...

Cordialement

bonjour

sans VBA

avec une colonne de ^pointage CODE (il faudra que tu complètes pour afficher A0 ou bien Balancelle1 etc. )

et des TCD

j'ai fait celui pour A0

Salut jmd,

merci pour ton retour, pour ce que je veux faire c'est plus par vba.

Car ce n'est que le début de ce que je veux faire,

1er) trier

2) faire des calculs...

Comme j'aurais des milliers de lignes, pour un gain de temps le mieux est en vba.

Merci

re

VBA va ralentir, en phase de mise au point et en phase de travail régulier

les TCD manipulent des millions de lignes

les calculs ultérieurs peuvent se faire à partir de TCD

que veux-tu faire ?

Bonjour jmd,

Désolé de n'avoir pas plus répondre plus tôt.

Tu as surement raison lorsque tu dit que cela prendrais du temps.

Merci

re

quel est ton BUT ?

à quoi sert ton (tes) fichier(s) ?

Bonsoir jmd, christian77,

Essaie ceci :

Option Explicit
Sub test()
Dim dico As Object, i As Long, e, txt As String
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    Application.ScreenUpdating = False
    With Sheets("BDD").Cells(1).CurrentRegion
        For i = 2 To .Rows.Count
            If .Cells(i, 5).Value Like "A0*" Or .Cells(i, 5).Value Like "B0*" Then
                txt = Left$(.Cells(i, 5).Value, 2)
            Else
                txt = .Cells(i, 5).Value
            End If
            If Not dico.exists(txt) Then
                Set dico(txt) = .Rows(1)
            End If
            Set dico(txt) = Union(dico(txt), .Rows(i))
        Next
    End With
    For Each e In dico.keys
        If Not IsSheetExists(e) Then
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = e
        End If
        With Sheets(e).Cells(1)
            .CurrentRegion.Clear
            dico(e).Copy .Cells
            With .CurrentRegion
                With .Rows(1)
                    .HorizontalAlignment = xlCenter
                End With
                .Columns.ColumnWidth = Array(11, 11, 11, 11, 17)
            End With
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Function IsSheetExists(ByVal sn As String) As Boolean
    On Error Resume Next
    IsSheetExists = Len(Sheets(sn).Name)
End Function

klin89