Creation de feuille automatique

bonsoir à tous

auriez vous une solution à ceci

j'ai un tableau sur ma feuil1 de A5 à V500

je voudrais une macro permettant de trier les noms en colonne D et que ceux ci viennent dans divers feuilles qui seront créer automatiquement .

je joins un exemple

j'aimerais que les lignes de la colonne soit copiées dans les autres feuilles .

je suis en xl2000 et malgré quelque recherches sur votre site les macros ne marchent pas avec ma version.

merci

BONSOIR

A TESTER ET ADAPTER SI BESOIN

Bonjour

ALEX91 a écrit :

je voudrais une macro

ALEX91 a écrit :

les macros ne marchent pas avec ma version.

On fait comment alors ?

Bonjour,

A tester

ALT F8 et exécuter 'ExtractReps'

ou

Ctrl + w

A te relire.

Cdlt

Option Explicit
Public Sub ExtractReps()
Dim Wss As Worksheet, WsNew As Worksheet
Dim rng As Range, c As Range
Dim r As Long
Dim bAF As Boolean
    Application.ScreenUpdating = False
    Set Wss = Sheets("Base")
    With Wss
        Set rng = .Range("A1").CurrentRegion
        bAF = .AutoFilterMode
        'extract a list of Sales Reps
        .Columns("D:D").Copy Destination:=.Range("Y1")
        .Columns("Y:Y").AdvancedFilter _
            Action:=xlFilterCopy, _
            CopyToRange:=.Range("X1"), _
            Unique:=True
        r = .Cells(Rows.Count, "X").End(xlUp).Row
        .Columns("Y:Y").ClearContents
        'set up Criteria Area
        .Range("Y1").Value = .Range("D1").Value
        For Each c In .Range("X2:X" & r)
            'add the rep name to the criteria area
            .Range("Y2").Value = "=""="" & " & Chr(34) & c.Value & Chr(34)
            'add new sheet (if required)
            'and run advanced filter
            If WksExists(c.Value) Then
                Sheets(c.Value).Cells.Clear
                rng.AdvancedFilter _
                    Action:=xlFilterCopy, _
                    CriteriaRange:=.Range("Y1:Y2"), _
                    CopyToRange:=Sheets(c.Value).Range("A1"), _
                    Unique:=False
            Else
                Set WsNew = Sheets.Add
                WsNew.Move After:=Worksheets(Worksheets.Count)
                WsNew.Name = c.Value
                rng.AdvancedFilter _
                    Action:=xlFilterCopy, _
                    CriteriaRange:=.Range("Y1:Y2"), _
                    CopyToRange:=WsNew.Range("A1"), _
                    Unique:=False
            End If
        Next
        .Select
        .Columns("X:Y").ClearContents
        If bAF = True Then
            .Range("A1").AutoFilter
        End If
    End With
End Sub
Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
    On Error GoTo 0
End Function

Testé sur office 2002 et 2007

Sub filtre()

Sheets("Feuil1").Select

If ActiveSheet.AutoFilterMode Then

ActiveSheet.Cells.Select

Selection.AutoFilter

End If

'tri

dernligne = ActiveSheet.Range("D60000").End(xlUp).Offset(0, 0).Row 'je ne me rappelle plus du nbre de ligne max ds excel 2000

Range("A5").CurrentRegion.Select

Selection.Sort Key1:=Range("D6:D" & dernligne), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

DataOption1:=xlSortNormal

'filtre

Application.GoTo Reference:="Liste" 'zone de nom définie dans la feuille colonne D

For Each S In Selection

If S <> "" Then

Sheets("Feuil1").Select

Range("A5").Select

Selection.CurrentRegion.Select

Selection.AutoFilter

Selection.AutoFilter Field:=4, Criteria1:=S

For Each fich In ThisWorkbook.Worksheets

fname = fich.Name

If fname = S Then

GoTo 1

Else

End If

Sheets("Feuil1").Activate

Next

Selection.CurrentRegion.Select

Selection.Copy

Sheets.Add

ActiveSheet.Paste

ActiveSheet.Name = S

1

Else

End If

Next

Sheets("Feuil1").Select

If ActiveSheet.AutoFilterMode Then

ActiveSheet.Cells.Select

Selection.AutoFilter

End If

End Sub

Bonjour

Une macro de plus à tester

Re,

Ci-joint mise à jour demandé par MP.

Pas très cool pour rudolf et Banzai64 qui t'ont répondu

Il est préférable de continuer sur le forum.

Cdlt

Mais on a continué sur le forum Eric Jean, vu comme on a des versions différentes, moi j'ai préféré corriger mon 1er code qui ne fonctionnait pas avant de me pencher sur les autres. Et vu mon historique, je ne me sens pas assez crédible pour juger du code de Banzai64 ou du tien

Mais franchement, c'est bien la diversité des codes, l'utilisateur peux tester et en fonction de son niveau ,choisir ce qui lui va

Amicalement,

Rudolf

bonsoir tout d'abord

une petite mise au point pour jean eric

j'ai pu testé hier le code de banzai ..sur excel 2003 et non sur excel 2000 il passait très bien et je voulais le tester sur 2000 avant de repondre à banzai

en aucun cas je ne voulais blesser qui que ce soit et surtout pas banzai.. si c'est le cas je m'en excuse platement.

d'autant plus que le code de banzai est superbe.

cordialement

merci à tous ceux qui m'ont répondu

re bonsoir

quant à ton code jean eric je viens de le tester sur 2003...il passe très bien...je le testerai demain sur 2000 et te tiendrais au courant si j'ai un problème. toujours est il que je me retrouve avec 3 codes super avec celui de banzai rudolf et je vais devoir en choisir un .

en tout cas merci du boulot jean eric et merci egalement au boulot de rudolf qui aplanit les angles . merci à lui

macro testé et qui marche très bien sur excel 2000 merci à jean eric