Macro Couper/coller selon un critère

khroutchev

XLDnaute Nouveau
Quelqu'un peut-il m'aider sur ce code .... seul le filtre beug.

Code:
Option Explicit
 
Sub Renomme()
    Worksheets("Feuil2").Name = "SURCOMP"
End Sub
 
Sub Filtre()
    With Worksheets("Feuil1")
        If .FilterMode = True Then .ShowAllData
        .[A1].AutoFilter Field:=5, Criteria1:=Array("9421", "9422", "9423"), Operator:=xlFilterValues
    End With
End Sub
 
Public Sub Traitement()
    Worksheets("Feuil1").UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Feuil2").Range("A1")
End Sub

Merci d'avance ;)
 

khroutchev

XLDnaute Nouveau
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.
 

GIBI

XLDnaute Impliqué
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)
 
Dernière édition:

khroutchev

XLDnaute Nouveau
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
 

Discussions similaires

Réponses
2
Affichages
133

Statistiques des forums

Discussions
312 388
Messages
2 087 878
Membres
103 672
dernier inscrit
ammarhouichi