Macro Couper/coller selon un critère

Re : Macro Couper/coller selon un critère

Bonjour,

ton code fonctionne bien en excel 2007 mais pas en 2003 ==> je creuse

GIBI

Re : Macro Couper/coller selon un critère

Merci beaucoup !

Re : Macro Couper/coller selon un critère

Sub Filtre()
Dim i As Integer
With Sheets("Feuil1")
For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Left(.Cells(i, 5), 4) = "9421" Then
Select Case .Cells(i, 5)
Case 9421: GoTo suite
End Select
End If
.Cells(i, 5).EntireRow.Delete
suite:
Next
End With
End Sub

Mais mainbtenant il faut le faire pour 9422 et 9423 sinon ça marche pour celui ci.

Re : Macro Couper/coller selon un critère

a priori si tu es en 2003 tu ne peux avoir que 2 critères

dans ton exemple tu peux écrire

.[A1].AutoFilter Field:=1, Criteria1:=">=9421", Operator:=xlAnd, Criteria2:="<=9423"

la solution est de passer par les filtre élaboré ou d'ajouter une colonne dans ton tableau pour traiter le cas

Bon courage

GIBI


Je viens de voir ton code : à quoi sert le select Case?

si tu veux supprimer toutes les lignes qui commence pat 9421 22 23

For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Left(.Cells(i, 5), 4) = "9421" or Left(.Cells(i, 5), 4) = "9422" or Left(.Cells(i, 5), 4) = "9423" Then
.Rows(i).Delete
end if
Next


tu veux peut^^tre supprimer les lignes dont la colonne 5 commence par 9421 mais est différente de 9421?

le test sera pour chaque élément (Left(.Cells(i, 5), 4) = "9421" and .Cells(i, 5) <> "9421")
ou (Left(.Cells(i, 5), 4) = "9421" and len(.Cells(i, 5))>4)

Re : Macro Couper/coller selon un critère

Option Explicit

Sub Renomme()
Worksheets("Feuil2").Name = "SURCOMP"
End Sub

Sub Filtre()
Dim i As Integer
With Sheets("Feuil1")
For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Left(.Cells(i, 6), 17) = "Surcomplémentaire" Then
GoTo suite
End If
.Cells(i, 5).EntireRow.Delete
suite:
Next
End With
End Sub

Public Sub Traitement()
Worksheets("Feuil1").UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Feuil2").Range("A1")
End Sub