Discussion :

[tarmin]

Bonjour,

J'ai crée le code suivant (avec l'aide de forum ) mais je ne parviens pas à l'afiner comme j'aimerais...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
' Sélectionne l'ensemble des données (utile pour qu'Excel ne "réfléchisse" pas sur les 65000 lignes)
Sub exemple()
Sheets("En attente").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select
 
For Each Rw In Selection.Rows
 
Ligne = Sheets("Envoyées").Range("a65530").End(xlUp).Row + 1
 
If Rw.Cells(1, 9).Value = "x" Then 'test la colonne I
Rw.Cut Destination:=Worksheets("Envoyées").Cells(Ligne, 1).EntireRow
 
 
End If
 
Next Rw
 
End Sub

La recherche fonctionne mais c'est le cut qui me posse problème. Il serait peut être plus facile de choisir une autre méthode mais laquelle et comment... ?

Il faudrait que ça copie dans ma feuille "envoyées" toutes les lignes de A à H (actuellement ça prend toutes la ligne y compris la I qui est la dernière de mon tableau) de la feuille "En attente" qui ont un x dans la colonne I. Ensuite il faudrait que toutes les ligne qui ont été copier soit effacées.

Le top serai encore que ça me copie la formule qui se trouve dans la colonne I de ma feuille "envoyées" dans les nouvelles lignes...

Si quelqu'un aurait une petite idée...

[fred65200]

bonjour,
un petit code à tester

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Essai()
Dim DerLiEnAttente As Long
Dim DerLiEnvoyees As Long
Dim i As Long
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("En attente")
Set F2 = Sheets("Envoyées")
 
'recherche de la dernière ligne feuille En attente
DerLiEnAttente = F1.Columns(1).Find("*", , , , , xlPrevious).Row
 
'recherche de la dernière ligne feuille Envoyées
On Error Resume Next
DerLiEnvoyees = F2.Columns(1).Find("*", , , , , xlPrevious).Row + 1
If Err.Number <> 0 Then Err.Clear: On Error GoTo 0: DerLiEnvoyees = 1
 
'boucle
For i = DerLiEnAttente To 1 Step -1
    'recherche du X
    If UCase(F1.Cells(i, "I").Value) = "X" Then
        'copie de la plage de cellule
        Range(F1.Cells(i, "A"), F1.Cells(i, "I")).Copy F2.Cells(DerLiEnvoyees, 1)
        'suppression de la ligne
        Rows(i).Delete Shift:=xlUp
        'incrementation
        DerLiEnvoyees = DerLiEnvoyees + 1
    End If
'fin de boucle
Next
 
End Sub

Je n'ai pas trop compris ta demande d'incrémentation de formule,

enregistre avec l'éditeur de macro, tu devrais t'en sortir.

Cordialement

[tarmin]

Super ! Ca fonctionne. Le seul "truc" qu'il y aurait encore à améliorer, c'est que si il y a un x dans la cellule I10 par exemple ça devrait coller dans ma deuxième feuille uniquement A10 à h10... Est-ce jouable ?

[fred65200]

re

oui, il te faut remplacer la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        Range(F1.Cells(i, "A"), F1.Cells(i, "I")).Copy F2.Cells(DerLiEnvoyees, 1)

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        Range(F1.Cells(i, "A"), F1.Cells(i, "H")).Copy F2.Cells(DerLiEnvoyees, 1)

Cordialement

[tarmin]

Ah oui

Ensuite j'ai ajouter ce code (qui ne fonctionne pas) après que j'ai collé mes données dans la feuille "Envoyées"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        Sheets("Envoyées").Range("I2").AutoFill Destination:=Sheets("Envoyées").Range(DerLiEnvoyees, "i")

La macro passe tout outre sans message d'erreur mais sans tirer ma formule jusqu'à la dernière ligne...

Si vous pouvez encore m'aider pour ça ce serait super !

[fred65200]

bonjour,
essaie d'ajouter cette ligne de code avant end sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    F2.Range("I2").AutoFill F2.Range("I2:I" & DerLiEnvoyees - 1)

cordialement