Copier et trier automatiquement les valeurs par ordre

Salut tout le monde.

En bref je cherche une fonction qui va m’aidé a copier a partir des opérations saisissent pendant la journée dans des compte spécifiques (classe) et par ordre chronologique a fin d’obtenir des résultats comme l’exemple dans le fichier ci-joint ou j’ai copier les donné manuellement.

J’espère que j’ai bien exprimé mon besoin et 1000 merci d’avance.

C'est pas clair du tout.

Bonjour,

Une proposition à méditer

Cdlt

salut Jean-Eric merci pour ton effort.

cette proposition est très idéal .

je vais l’essayer

1000 merci

Re,

Ou est-tu situé?

Question bête

Cdlt.

salut j'espère que je vous dérange pas.

bon , pour comprendre le travail que tu as effectuer sur le fichier précédent "car je n'y trouver aucun fonction j'ai effectuer des recherche sur le net.

j'ai découvert que je suis nul car il y a quelque chose qui s’appelle vba que je ne la maitraise pas encore.

bon après un peut d'effort j' trouvé ces code que vous avez utilisé :

Option Explicit

Option Private Module

Public Sub ExtractCLASS()

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("OPERATION DU JOUR")

With Wss

Set rng = .Range("A1").CurrentRegion

bAF = .AutoFilterMode

'extract a list of Sales Reps

.Columns("A:A").Copy Destination:=.Range("F1")

.Columns("F:F").AdvancedFilter _

Action:=xlFilterCopy, _

CopyToRange:=.Range("E1"), _

Unique:=True

r = .Cells(Rows.Count, "E").End(xlUp).Row

.Columns("F:F").ClearContents

'set up Criteria Area

.Range("F1").Value = .Range("A1").Value

For Each c In .Range("E2:E" & r)

'add the rep name to the criteria area

.Range("F2").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("F1:F2"), _

CopyToRange:=Sheets(c.Value).Range("A1"), _

Unique:=False

Else

Set WsNew = Sheets.Add

WsNew.Move After:=Worksheets(Worksheets.Count)

WsNew.Name = "CLASS " & c.Value

rng.AdvancedFilter _

Action:=xlFilterCopy, _

CriteriaRange:=.Range("F1:F2"), _

CopyToRange:=WsNew.Range("A1"), _

Unique:=False

End If

Next

.Select

.Columns("E:F").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

Public Sub FormatSheets()

Dim ws As Worksheet

Dim loTable As ListObject

Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets

If ws.Name <> "OPERATION DU JOUR" Then

Set loTable = ws.ListObjects.Add(xlSrcRange, ws.Range("A1").CurrentRegion, , xlYes)

With loTable

.Name = "tb" & ws.Name

.TableStyle = "TableStyleMedium1"

.ShowTotals = True

End With

End If

Next

End Sub

Sub SortSheets()

Dim x As Variant

Dim i As Byte

Application.ScreenUpdating = False

For Each x In ActiveWorkbook.Sheets

For i = 3 To ActiveWorkbook.Sheets.Count

If Sheets(i - 1).Name > Sheets(i).Name Then

Sheets(i - 1).Move After:=Sheets(i)

End If

Next

Next

End Sub

pouvez vous les traduire car je n'ai rien compris

et merci une autre foi