Copier des lignes d'une feuille a une autre avec une condition [Résolu]

Signaler
Messages postés
14
Date d'inscription
lundi 25 décembre 2000
Statut
Membre
Dernière intervention
17 mars 2009
-
Messages postés
577
Date d'inscription
vendredi 26 septembre 2008
Statut
Membre
Dernière intervention
20 novembre 2010
-
bonjour a tous,
Jai un petit problème avec mon code.A partir d'une userform nommée 'histofil' et d'un combobox nommé 'histf' je voudrait copier des lignes d'une feuille nommée CHFIL et les coller dans une autre nommée Feuil1.Dans CHFIL je renseigne des interventions.Il peut y avoir des doublons a copier.J'ai réussi a faire une scrutation de CHFIL mais rien ne se copie dans Feuil1.Je n'ai aucune erreur qui apparait lorsque je lance le code,mais rien ne se copie non plus(ce qui prouve que mon code n'est pas si terrible que ça).Je débute et je rame un peu (beaucoup).Je joint mon code.
Quelqu'un vroudrait-il me donner un petit coup de pouce ?
Merci
Private Sub hfilok_Click()
Dim x As Integer
For x = 2 To 20
Sheets("Feuil1").Select
Sheets("CHFIL").Select


If Worksheets("CHFIL").Columns("C:C").Cells(x, 3).Value = Me.histf.Value Then
   Worksheets("CHFIL").Row ("2:X")
   Sheets("Feuil1").Select
CopyToRange:    Rows.Cells([2.3].[c;c]).End (xlUp)
End
End If
Next
histofil.Hide
End Sub

4 réponses

Messages postés
577
Date d'inscription
vendredi 26 septembre 2008
Statut
Membre
Dernière intervention
20 novembre 2010
4
Bonjour yy022


J'avoue que je n'ai pas bien compris. Est-ce que tu veux lire la colonne C de la feuille CHFIL depuis la ligne 2 jusqu'à la ligne 20, et copie la ligne entière dans la feuille Feuil1 si la cellule en colonne C est égale à Me.histf.Value ?

Si c'est ça, le code ci-dessous devrait fonctionner :

Option Explicit
Private Sub hfilok_Click()
Dim x As Integer, y As Integer
Worksheets("Feuil1").Select
Application.ScreenUpdating = False
With Worksheets("CHFIL")
    For x = 2 To 20
        If .Cells(x, 3).Value = Me.histf.Value Then
            y = y + 1
            .Rows(x).Copy
            Cells(y, 1).Select
            ActiveSheet.Paste
        End If
    Next
End With
Application.ScreenUpdating = True
' histofil.Hide
End Sub

Cordialement
Messages postés
14
Date d'inscription
lundi 25 décembre 2000
Statut
Membre
Dernière intervention
17 mars 2009

Merci a tous les deux de m'avoir repondu.
orohena , j'ai pris ton code et ai juste modifié me.histf.value par me.histf.text.
Maintenant ca roule mon affaire.
Encore merci et bon week-end a toi ainsi qu'a pil_poil
Cordialement
Messages postés
682
Date d'inscription
vendredi 6 avril 2007
Statut
Membre
Dernière intervention
4 août 2012
6
bonjour
on peut faire bien plus simplement encore

Option Explicit

Private Sub hfilok_Click()
    Dim x As Integer, y As Integer
    Application.ScreenUpdating = False
    For x = 2 To 20
        If Worksheets("Feuil1").cells(x,3) = histf.text Then
            y = y + 1
            Worksheets("Feuil1") Cells(y, 1) = Worksheets("Feuil1").cells(x,3)
        End If
    Next x
    Application.ScreenUpdating = True
End Sub
avec l'avantage de pouvoir etre dans dans n'importe quel onglet de la feuille excel

[reglement.aspx ]si c'est la solution, penser : REPONSE ACCEPTEE
Messages postés
577
Date d'inscription
vendredi 26 septembre 2008
Statut
Membre
Dernière intervention
20 novembre 2010
4
bonjour

pile_poil, cher ami, ton code ne copie qu'une cellule. yy022 a dit je voudrait copier des lignes

Bon week