Pour Jacquouille

Bonjour,

Version Feuilles (refait dans un nouveau classeur, plus de bug).

http://cjoint.com/?iAod6mD0hB



Sub aaGenerSh()
Dim i As Long, Sh As Worksheet, j As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Sh In ThisWorkbook.Sheets
Select Case Sh.CodeName
Case "Feuil1", "Feuil2", "Feuil3"
'on fait rien
Case Else
Sh.Delete
End Select
Next Sh
Application.DisplayAlerts = True

For i = 4 To 166

Feuil1.Copy before:=Sheets("Fin")
With ActiveSheet
.Name = Left(.Cells(2, i), 31)
Application.StatusBar = .Name
For j = 166 To 4 Step -1
If j <> i Then .Columns(j).EntireColumn.Delete
Next j
Range("A2:D41").Sort Key1:=Range("D3"), Order1:=xlDescending, Header:=
_
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
.[8:36].EntireRow.Delete
.[8:8].EntireRow.Insert
End With
Next i
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

'LSteph