[XL-2007] copier,coller puis supprimer de feuille à feuille [Résolu]

[ploneis]

Bonjour,

Le but de cette mini macro est de copier une ligne de la feuille "IN"si la valeur de la cellule "G" correspond à "Ter" , puis de la coller à la première cellule vide de la feuille "Te", puis de supprimer la ligne de la feuille "IN"

J'ai écrit cette macro avec des boucles (souvenir de BASIC)
Elle fonctionne pour une ligne, pour des lignes entrecoupées de différentes valeurs de la colonne "G".
Par contre, si deux lignes contigües ont en colonne "G" deux ou plusieurs fois la valeur "Ter", cela ne fonctionne pas bien.Je suis obligé de relancer plusieurs la macro sinon des lignes contenant "Ter"en colonne "G" reste en "IN"

Je n'arrive pas à améliorer cette macro afin que d' un seul lancement elle transfere le contenu de la ligne concernée vers l'auutre feuille, puis d' effacer la ligne de la feuille initiale.

Pouvez-vous m'aider ?
Merci par avance

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
Public Sub Passage_termine()
Dim cellulecourante As Range
 
    ScreenUpdating = False
    Call vide_presse_papier
    Sheets("IN").Select
    Worksheets("IN").AutoFilterMode = False
     For Each cellulecourante In Range("notation") ' correspond aux valeurs de la colonne "G"
    If cellulecourante.Value = "Ter" Then
    cellulecourante.EntireRow.Copy
    Sheets("Te").Select
    Worksheets("Te").AutoFilterMode = False
    Range("A1").Select
    Do While ActiveCell <> ""
    ActiveCell.Offset(1, 0).Select
    Loop
    ActiveSheet.Paste
    Sheets("IN").Select
   cellulecourante.EntireRow.Delete
   ElseIf cellulecourante.Value <> "Ter" Then
   Set cellulecourante = cellulecourante.Offset(1, 0)
   End If
   Next
   screemupdating = True
 
End Sub

Code :

1
2
3
Public Sub vide_presse_papier()
Application.CutCopyMode = False
End Sub

[patricktoulon]

bonjour

ou!!!lala toi te casser beaucoup la tète pour pas grand chose

utilise plutôt la function find et find next tu verra sa marchera mieux

d'autant plus que dans ton exemple tu boucle sur la même cellule indéfiniment


au plaisir

[Daniel.C]

Bonjour,

J'ai remanié un peu ton code, mais je ne l'ai pas testé. Quand on supprime des lignes, on le fait en parcourant la plage du bas vers le haut, justement pour éviter les problèmes que tu as rencontrés.

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
Public Sub Passage_termine()
Dim cellulecourante As Range, DerLig As Long, PremLig As Long
 
ScreenUpdating = False
Call vide_presse_papier
Sheets("IN").Select
Worksheets("IN").AutoFilterMode = False
With Range("notation")
    DerLig = .Row + .Rows.Count - 1
    PremLig = .Row
End With
For i = .Row + .Rows.Count - 1 To .Row Step -1
    If Cells(i, 7).Value = "Ter" Then
        Cells(i, 7).EntireRow.Copy
        With Sheets("Te")
            .AutoFilterMode = False
            .Cells(.Cells.Rows.Count, 1).End(xlUp).Offset(1).Paste
        End With
        Cells(i, 7).EntireRow.Delete
    End If
Next i
ScreenUpdating = True
 
End Sub

[ploneis]

Code :

.Cells(.Cells.Rows.Count, 1).End(xlUp).Offset(1).Paste

Lors de l'essai le message 438 apparait propriété non gérée par cet objet.
En épluchant le code je ne vois aucune raison, pouvez vous m'aider ?
Je vous en remercie

[Daniel.C]

Essaie :

Code :

.Cells(.Cells.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues

[ploneis]

Bonjour Daniel et PatrickToulon,

Malgré la proposition de Daniel, la macro "se plante " à :.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues

J'ai essayé en décomposant, en incluant select, sans amélioration.

Je me demande si les trois boucles (for,if, et with) ne créent pas une interaction
inopportune......

Cordialement

----------------------------------------------------------------------------Ne crains pas d'avancer lentement, seulement de t'arrêter .

[Daniel.C]

Il y avait bien une erreur de compilation qui empêchait le code de s'exécuter. J'ai testé celui-ci en reconstituant ton environnement. Il suppose que la colonne A est remplie, faute de quoi, il faudra (encore) la modifier :

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
Public Sub Passage_termine()
Dim cellulecourante As Range, DerLig As Long, PremLig As Long
 
ScreenUpdating = False
'Call vide_presse_papier
Sheets("IN").Select
Worksheets("IN").AutoFilterMode = False
With Range("notation")
    DerLig = .Row + .Rows.Count - 1
    PremLig = .Row
End With
For i = DerLig To PremLig Step -1
    If Cells(i, 7).Value = "Ter" Then
        Cells(i, 7).EntireRow.Copy
        With Sheets("Te")
            .AutoFilterMode = False
            .Cells(.Cells.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        End With
        Cells(i, 7).EntireRow.Delete
    End If
Next i
ScreenUpdating = True
 
End Sub

[ploneis]

Bonjour Daniel,

C'est parfait, ça boucle bien.

[Daniel.C]

Merci du retour; pense à marquer la question comme résolue.