Aide macro pour faire passer une ligne a une autre feuille.

SaintCyr

XLDnaute Nouveau
Bonjour à tous.


Depuis hier je traine sur votre forum et sur internet, afin de pouvoir faire ma macro, mais malheureusement après plusieurs tentatives, c'est un echec. Je me tourne donc vers vous pour éclairer ma lanterne. :)


Donc voici mon problème : Dans mon fichier, quand on met un X dans la colonne "finit" je voudrai que la ligne soit copié, puis collé dans l'autre feuille. Puis supprimé de la première feuille. Ou du moins caché.


Je vous met en PJ le fichier et mon début de macro... Etant très très novice en la matière....


'
' MacroArchive Macro
'

'Sub Archivage'()
Dim I As Long, Plage As Range, Ligne As Long
On Error Resume Next
Ligne = Sheets("missions fini").Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
If Err.Number > 0 Then Ligne = 0
On Error GoTo 0
With Sheets("consigne")
For I = 1 To .Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
If Application.CountIf(.Rows(I), 4) > 0 Then
Ligne = Ligne + 1
.Rows(I).Copy Sheets("missions fini").Cells(Ligne, 1)
End If
Next I
End With
End Sub


Merci d'avance.

Bien cordialement.
 

Pièces jointes

  • Consigne Protec - Copie.xlsx
    119.7 KB · Affichages: 41

Borismy

XLDnaute Occasionnel
Re : Aide macro pour faire passer une ligne a une autre feuille.

Bonjour,

a adapter et tester
Code:
Sub Test_ligne()
Dim cell As Range
Sheets("Feuil1").Select
Application.ScreenUpdating = False
For Each cell In Sheets("Feuil1").Range("h4:h" & Sheets("Feuil1").Range("h65536").End(xlUp).Row)
If cell.Value = "X" Then
cell.EntireRow.Cut Destination:=Sheets("Feuil3").Cells(Sheets("Feuil3").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Application.ScreenUpdating = True
End Sub

A+
Boris
 

SaintCyr

XLDnaute Nouveau
Re : Aide macro pour faire passer une ligne a une autre feuille.

Bonjour,

a adapter et tester
Code:
Sub Test_ligne()
Dim cell As Range
Sheets("Feuil1").Select
Application.ScreenUpdating = False
For Each cell In Sheets("Feuil1").Range("h4:h" & Sheets("Feuil1").Range("h65536").End(xlUp).Row)
If cell.Value = "X" Then
cell.EntireRow.Cut Destination:=Sheets("Feuil3").Cells(Sheets("Feuil3").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Application.ScreenUpdating = True
End Sub

A+
Boris

Bonjour Boris!

Après avoir adapté, malheureusement rien de concret se passe, sûrement un problème de ma part.

Voici ce que j'ai mi :

Sub Test_ligne()
Dim cell As Range
Sheets("Consigne").Select
Application.ScreenUpdating = False
For Each cell In Sheets("consigne").Range("h4:h" & Sheets("consigne").Range("h65536").End(xlUp).Row)
If cell.Value = "X" Then
cell.EntireRow.Cut Destination:=Sheets("mission fini").Cells(Sheets("mission fini").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Application.ScreenUpdating = True
End Sub

Que faire?

En tout cas je te remercie du temps que tu m'as gentiement accordé.


Bien cordialement.
 

Discussions similaires

Réponses
7
Affichages
322

Statistiques des forums

Discussions
312 095
Messages
2 085 250
Membres
102 837
dernier inscrit
CRETE