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