copier des lignes

[Sonskriverez]

Bonsoir le forum

Je cherche à copier sur une autre feuille et supprimer des lignes qui contiennent des informaions précises dans le contenu d'une cellule, mon code ne fait la différence et copie toute les ligne Why ?

merci de votre aide [file name=textedanstexte_20051216174157.zip size=10544]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/textedanstexte_20051216174157.zip[/file]

 

[Sonskriverez]

oups, petit bug... y=12 bien sur

 

[Excel_lent]

Salut,
Bonjour à tous,

Essaie cela

For i = 2 To Range('L65536').End(xlUp).Row    
        If InStrRev(Cells(i, y), objectif, , vbTextCompare) = 0 Then

@+

 

[michel_m]

bonsoir,

ci dessous proposition recopie en colonne L de feuil2 les cellules avec samedi: on ne boucle que sur les 'samedi' et on utilise pas 'select' (avec 39000 lignes, t'es pas arrivé...)

à compléter avec ton inputbox de sélection de feuille



Dim lig As Long, fin As Long, cptr As Long
Dim liste As Collection

Set liste = New Collection

lig = 1
fin = Application.CountA(Range('L:L'))
Do Until lig = fin
On Error Resume Next
lig = Columns(12).Find('samedi', Cells(lig, 12), xlPart).Row
If Err.Number > 0 Then
Exit Do
End If
liste.Add Cells(lig, 12).Value
Loop

Set sht1 = Worksheets('feuil1')
Set sht2 = Worksheets('feuil2')

With sht2
.Cells(1, 12) = sht1.Cells(1, 12)
cptr = 1
fin = liste.Count
While cptr <= fin
.Cells(cptr + 1, 12) = liste(cptr)
cptr = cptr + 1
Wend
End With
Set liste = Nothing

 

[le Fnake]

Bonsoir Sonskriverez, le forum

je pense que le problème a lieu à la ligne
If InStrRev(cell.Value, objectif, , vbTextCompare) > 0 Then
car cell.value n'existe pas.

Tu peux donc remplacer ce bloc par :

    derligne = Range('Feuil1!L65500').End(xlUp).Row  'bien choisir la colonne des données et la ligne de départ
    For Each cell In Range('L2:L' & derligne)
        If InStrRev(cell.Value, objectif, , vbTextCompare) > 0 Then
            cell.EntireRow.Select

En tout cas, chez moi, ca marche ! B)

Bon courage

le Fnake

 

[ChTi160]

Salut Sonskriverez
bonsoir le Fil

pour en finir je crois lol
pour effacer la ligne en feuil1 si j'ai bien compris, ajouter

For Each cell In Range('L2:L' & derligne)
        If InStrRev(cell.Value, objectif, , vbTextCompare) > 0 Then
           cell.EntireRow.Select
       Selection.Copy
            sht2.Select
            Rows(j).Select
            j = j + 1
            ActiveSheet.Paste
            sht1.Select
            Selection.Delete 'supprime la ligne en Feuil1
            
        End If
    Next

bonne soirée
Bon WeekEnd

 

[Sonskriverez]

Bonjour et merci pour votre aide, alors c'est un mystère (1 de plus) chez moi cela ne marche pas. Ma bécane n'aime pas InStrRev tant pis je m'en suis sortie avec

If Cells(i, y) Like '*Ordered*' Then

Merci encore

il faut que le père Noël m'apporte une touche F8 la mienne est usé