copie de cellule par macro

Version imprimable

Bjr,

J'ai 3 feuilles sur le même fichier, feuil1, feuil2, feuil3 !
Sur mes feuilles 1 et 2, j'ai la même forme de tableau en A B C D, ma feuille 3 est vide.
Je voudrais que pour mes 2 feuilles, si une condition est rempli en colonne B, (>90) , la ligne correpondante soit ecrite sur ma feuille 3,
Je m'explique, si sur ma feuille 1, en B50 par exemple, ma condition est vérifié, je voudrais que la ligne 50 dc les colonne A B C D, soit écrite en ligne 1, A B C D de ma feuille 3. Si sur la feuille 2, B1000 est verifié, même chose mais en ligne2 de ma feuille3 et ainsi de suite...
Jai une bout de code qui ne marche pas, pe être je me trompe de direction, merci de votre aide.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub erreur() Sheets("Feuil1").Columns("B:B").Select For Each cell In Selection If cell > 90 Then ligne1 = cell.Row Sheets("Feuil3").Select ligne = Sheets("Feuil3").Range("A65536").End(xlUp).Row Sheets("Feuil1").Range("A" & ligne1).Copy = ActiveCell.FormulaR1C1.Feuil3.Range("A" & ligne) Sheets("Feuil1").Range("B" & ligne1).Copy = ActiveCell.FormulaR1C1.Feuil3.Range("B" & ligne) Sheets("Feuil1").Range("C" & ligne1).Copy = ActiveCell.FormulaR1C1.Feuil3.Range("C" & ligne) Sheets("Feuil1").Range("D" & ligne1).Copy = ActiveCell.FormulaR1C1.Feuil3.Range("D" & ligne) End If Next cell End Sub

09/06/2008, 09h54
ouskel'n'or

Avec ton code il est difficile de savoir ce que tu copies. Tu as donc deux versions possibles

Code:

Worksheets("Feuil3").Range("A" & ligne).copy Worksheets("Feuil1").Range("A" & ligne1)

pour copier de feuil3 vers feuil1
ou

Code:

Worksheets("Feuil1").Range("A" & ligne1).Copy Worksheets("Feuil3").Range("A" & ligne)

pour copier de feuil1 vers feuil3 ;)

Je copie de la feuille 1 vers la feuille3
Ca me emt tjr le même message d'erreur, "La methode select de la classe Range a échouer"
Pourtant ca devrais être bon,
Pour chaque cellulle de ma colonne B, je regarde si c'est supérieur a 90, si ca l'est je copie A B C D de la feuille 1 après la derniére ligne ecrite de la feuille3.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sheets("Feuil1").Columns("B:B").Select
    For Each cell In Selection
        If cell > 90 Then
            ligne1 = cell.Row
            Sheets("Feuil3").Select
            ligne = Sheets("Feuil3").Range("A65536").End(xlUp).Row
            Worksheets("Feuil1").Range("A" & ligne1).Copy Worksheets("Feuil3").Range("A" & ligne)
            Worksheets("Feuil1").Range("B" & ligne1).Copy Worksheets("Feuil3").Range("B" & ligne)
            Worksheets("Feuil1").Range("C" & ligne1).Copy Worksheets("Feuil3").Range("C" & ligne)
            Worksheets("Feuil1").Range("D" & ligne1).Copy Worksheets("Feuil3").Range("D" & ligne)
        End If
    Next cell

Code:

1
2
3
4
5
6
7
8
9
10
11
Dim cell As Range
   For Each cell In Worksheets("Feuil1").Range("B:B")
        If cell > 90 Then
            ligne1 = cell.Row
            Ligne = Sheets("Feuil3").Range("A65536").End(xlUp).Row
            Worksheets("Feuil1").Range("A" & ligne1).Copy Worksheets("Feuil3").Range("A" & Ligne)
            Worksheets("Feuil1").Range("B" & ligne1).Copy Worksheets("Feuil3").Range("B" & Ligne)
            Worksheets("Feuil1").Range("C" & ligne1).Copy Worksheets("Feuil3").Range("C" & Ligne)
            Worksheets("Feuil1").Range("D" & ligne1).Copy Worksheets("Feuil3").Range("D" & Ligne)
        End If
    Next cell

For Each cell In Worksheets("Feuil1") attend un range, pas une colonne ;)
Bonne journée

09/06/2008, 10h45
ptitepo

Ok,
Alors résultat, ca marche, mais le problème c'est que je ne peut avoir qu'une seul valeur suppérieur a 90, car il prend la derniére et la met sur la 1er ligne.
Il n'y a pas la succéssion des lignes sur la feuille 3, je ne peux pas mettre d'entete, car il écrit dessus.

ajoute un compteur

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Dim cell As Range
dim i as integer
i=0
   For Each cell In Worksheets("Feuil1").Range("B:B")
        If cell > 90 Then
            ligne1 = cell.Row
            Ligne = Sheets("Feuil3").Range("A65536").End(xlUp).Row
Ligne=Ligne+i
i=i+1
            Worksheets("Feuil1").Range("A" & ligne1).Copy Worksheets("Feuil3").Range("A" & Ligne)
            Worksheets("Feuil1").Range("B" & ligne1).Copy Worksheets("Feuil3").Range("B" & Ligne)
            Worksheets("Feuil1").Range("C" & ligne1).Copy Worksheets("Feuil3").Range("C" & Ligne)
            Worksheets("Feuil1").Range("D" & ligne1).Copy Worksheets("Feuil3").Range("D" & Ligne)
        End If
    Next cell

09/06/2008, 11h49
ptitepo
En faite la colonne B été trop vague il ne s'arreté jamais, donc j'ai ajouter
Code:

1 2 ligne = Sheets("Feuil" & i).Range("A65536").End(xlUp).Row For Each cell In Worksheets("Feuil" & i).Range("B2:B" & ligne)
Maintenant ca marche, merci de votre aide