nabilexcel2007
XLDnaute Occasionnel
Bonsoir
S'il vous plait mon code fonctionne bien
Sub Extrait()
Dim Rng As Range, I As Integer, L As Integer, L1 As Integer, L2 As Integer
Dim Tbl As Variant
Application.ScreenUpdating = False
Set Rng = Range("E2:E" & Range("E65536").End(xlUp).Row)
Tbl = Array("chaise", "adaptable")
For I = 0 To UBound(Tbl)
c = Application.WorksheetFunction.CountIf(Rng, "=*" & Tbl(I) & "*")
For L = 1 To c
Set cel = Rng.Find(Tbl(I))
If Not cel Is Nothing Then L1 = cel.Row
If L1 > 0 Then
With Sheets(Tbl(I))
If .Range("A1").Value = "" Then
L2 = 1
Else: L2 = .Range("A65536").End(xlUp).Row + 1
End If
.Range("A" & L2 & ":E" & L2).Value = Range("A" & L1 & ":E" & L1).Value
.Columns("A:E").AutoFit
End With
Rows(L1).Delete
L1 = 0
End If
Next L
Next I
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
Extrait
End Sub
j'aimerai faire un filtre a mon choix sur tout le tableau avec msgbox
Merci
S'il vous plait mon code fonctionne bien
Sub Extrait()
Dim Rng As Range, I As Integer, L As Integer, L1 As Integer, L2 As Integer
Dim Tbl As Variant
Application.ScreenUpdating = False
Set Rng = Range("E2:E" & Range("E65536").End(xlUp).Row)
Tbl = Array("chaise", "adaptable")
For I = 0 To UBound(Tbl)
c = Application.WorksheetFunction.CountIf(Rng, "=*" & Tbl(I) & "*")
For L = 1 To c
Set cel = Rng.Find(Tbl(I))
If Not cel Is Nothing Then L1 = cel.Row
If L1 > 0 Then
With Sheets(Tbl(I))
If .Range("A1").Value = "" Then
L2 = 1
Else: L2 = .Range("A65536").End(xlUp).Row + 1
End If
.Range("A" & L2 & ":E" & L2).Value = Range("A" & L1 & ":E" & L1).Value
.Columns("A:E").AutoFit
End With
Rows(L1).Delete
L1 = 0
End If
Next L
Next I
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
Extrait
End Sub
j'aimerai faire un filtre a mon choix sur tout le tableau avec msgbox
Merci