Bonjour merci de m'aider
j'ai bien ouvert le fichier de 10:45
en fait la macro s'arrete sur
(Columns('D').AutoFilter)
Je me doute que ca représante travail encore merci
C'est celle-ci :
Option Explicit
Private Sub CommandButton1_Click()
Dim bytCritere As Byte
Dim strCritere As String
Application.ScreenUpdating = False
Columns('D
').AutoFilter
For bytCritere = 2 To 5
Select Case bytCritere
Case 2: strCritere = 'BX'
Case 3: strCritere = 'CF'
Case 4: strCritere = 'CP'
Case 5: strCritere = 'SG'
End Select
Cells(1, 4).AutoFilter Field:=1, Criteria1:=strCritere
Range(Cells(2, 1), Selection.SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Select
If Selection.Row > 1 Then
Selection.Copy
With Sheets(bytCritere)
.Select
.Cells(65536, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
End With
Sheets(1).Select
End If
Next bytCritere
Cells(1, 4).AutoFilter Field:=1
Cells(1, 1).Select
Range('D1
10000').Select
Selection.AutoFilter
Application.ScreenUpdating = True
End Sub
René du var