Hellboy à dit:Bonjour
Une suggestion:
Public Sub Test()
Dim intLigne As Integer
For intLigne = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row Step 2
With Range(Cells(intLigne, 1), Cells(intLigne, 3))
.Copy Destination:=Sheets(2).Cells(Cells.End(xlUp).Row + 1, 1)
' si tu veux effacer les données
' .Clear
End With
Next intLigne
End Sub
Sub Test()
Dim intLigne As Integer
If Selection.Count > 1 Then MsgBox "Selectionnez une seule cellule": Exit Sub
For intLigne = 2 To Range("A65536").End(xlUp).Row
If Cells(intLigne, 5).Value = Selection.Value Then
Cells(intLigne, 1).EntireRow.Copy Destination:=Sheets(2).Cells(Sheets(2).Range("A65536").End(xlUp).Offset(1, 0).Row, 1)
End If
Next intLigne
End Sub
porcinet82 à dit:re,
Comme je ne suis pas sur que la macro de Hellboy focntionne comme tu le souhaites (je suppose q'on a pas compris la meme chose en ce qui concerne ta demande), j'ai modifier son code de la manière suivante :
PHP:Sub Test() Dim intLigne As Integer If Selection.Count > 1 Then MsgBox "Selectionnez une seule cellule": Exit Sub For intLigne = 2 To Range("A65536").End(xlUp).Row If Cells(intLigne, 5).Value = Selection.Value Then Cells(intLigne, 1).EntireRow.Copy Destination:=Sheets(2).Cells(Sheets(2).Range("A65536").End(xlUp).Offset(1, 0).Row, 1) End If Next intLigne End Sub
La macro copie toutes les lignes identiques a la cellule sélectionnée.
@+
porcinet82 à dit:re,
Je viens de regarder ton fichier, normal que ca bug, la première ligne de ta macro (Sub macro 1()) est en commenaire, c'est à dire 'Sub macro1 ()
Il te suffit d'enlever l'apostrophe et ca doit fonctionner.
@+
Sub Test_v3()
Dim intLigne As Integer
Sheets(1).Select
If Selection.Count > 1 Then MsgBox "Selectionnez une seule cellule": Exit Sub
For intLigne = 2 To Range("A65536").End(xlUp).Row
If Cells(intLigne, Selection.Column).Value = Selection.Value Then
Cells(intLigne, 1).EntireRow.Copy Destination:=Sheets(2).Cells(Sheets(2).Range("A65536").End(xlUp).Offset(1, 0).Row, 1)
End If
Next intLigne
End Sub
Hellboy à dit:re a tous
La je ne comprend pas. D'après ton Post original, tu voulais copié une ligne sur deux. C'est ce que j'en ai déduit. Si tu as 10000 lignes, je ne pensais pas que tu voulais les sélectionner à la main. pour ensuite faire le copier coller de cette sélection ?
Je suis dans le brouillard la
porcinet82 à dit:Salut Yann,
Effectivement, le code n'etait pas adapter a toutes les possibilités, je l'ai modifié :
PHP:Sub Test_v3() Dim intLigne As Integer Sheets(1).Select If Selection.Count > 1 Then MsgBox "Selectionnez une seule cellule": Exit Sub For intLigne = 2 To Range("A65536").End(xlUp).Row If Cells(intLigne, Selection.Column).Value = Selection.Value Then Cells(intLigne, 1).EntireRow.Copy Destination:=Sheets(2).Cells(Sheets(2).Range("A65536").End(xlUp).Offset(1, 0).Row, 1) End If Next intLigne End Sub
@+
Sub Test_v4()
Dim intLigne As Integer
Sheets(1).Select
If Selection.Count > 1 Then MsgBox "Selectionnez une seule cellule": Exit Sub
For intLigne = 2 To Range("A65536").End(xlUp).Row
If Not Cells(intLigne, Selection.Column).Value = "" Then
Cells(intLigne, 1).EntireRow.Copy Destination:=Sheets(2).Cells(Sheets(2).Range("A65536").End(xlUp).Offset(1, 0).Row, 1)
End If
Next intLigne
End Sub