Problème avec la méthode cut

Version imprimable

Bonjour,

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

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...

bonjour,
un petit code à tester

Code:

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

03/09/2008, 16h29
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 ?
03/09/2008, 16h52
fred65200

re

oui, il te faut remplacer la ligne

Code:

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

par

Code:

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

Cordialement
04/09/2008, 08h34
tarmin

Ah oui :oops:

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:

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 !
04/09/2008, 10h20
fred65200

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

Code:

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

cordialement