Consolider des données excel VBS

Résolu/Fermé
Signaler
Messages postés
49
Date d'inscription
mercredi 24 août 2016
Statut
Membre
Dernière intervention
26 septembre 2016
-
Messages postés
154
Date d'inscription
jeudi 4 août 2016
Statut
Membre
Dernière intervention
9 septembre 2016
-
Bonjour,

Dans un souci d'automatisation, je cherche une solution pour pouvoir déplacer une ligne entière dont le contenu de la première colone (A) est égal à "Done" vers une autre feuille de mon classeur excel.

J'ai le code suivant, on ne m'indique pas d'erreur mais lorsque je le met en route, rien ne se passe :

'Procedure permettant la consolidation de plusieurs données

'Déclaration des variables
Dim i As Integer
Dim DerniereLigne As Integer
Dim LastRowConsolidate As Integer

Private Sub Consolidate_Click()
'Procedure permettant de déplacer les programmes terminés
Application.ScreenUpdating = False 'Désactivation du défilement de l'écran
Sheets("Master Data").Select 'Sélectionner la feuille master data"

Dernièreligne = Range("A100000").End(xlUp).Row

For i = 4 To DerniereLigne
If ActiveSheet.Cells(i, 1).Value = "Done" Then 'Si la cellule i de la colonne A contient Done alors
Rows(i).Select 'sélection de la ligne i
Selection.Cut 'Coupe la ligne 1
Sheets("Post Launch").Select 'Sélection de la feuille post launch
LastRowConsolidate = Range("A100000").End(xlUp).Row + 1
Cells(LastRowConsolidate, 1).Select
ActiveSheet.Paste 'Copier sur la feuille active

Application.CutCopyMode = False

End If
Next i
Application.ScreenUpdating = True
MsgBox "Le remplacement est terminé", vbOKOnly + vbInformation, "FYI"
End Sub


Une âme charitable aurait-elle la solution à mon problème :) ?

Je vous remercie par avance,

Agathe

1 réponse

Messages postés
154
Date d'inscription
jeudi 4 août 2016
Statut
Membre
Dernière intervention
9 septembre 2016
21
Bonjour,


Private Sub Consolidate_Click()

'Procedure permettant la consolidation de plusieurs données

'Déclaration des variables
Dim i As Integer
Dim DerniereLigne As Integer
Dim LastRowConsolidate As Integer

'Procedure permettant de déplacer les programmes terminés
Application.ScreenUpdating = False 'Désactivation du défilement de l'écran
Sheets("Master Data").Select 'Sélectionner la feuille master data"

DernièreLigne = Range("A100000").End(xlUp).Row

For i = 4 To DernièreLigne
If ActiveSheet.Cells(i, 1).Value = "Done" Then 'Si la cellule i de la colonne A contient Done alors
Rows(i).Select 'sélection de la ligne i
Selection.Cut 'Coupe la ligne 1
Sheets("Post Launch").Select 'Sélection de la feuille post launch
LastRowConsolidate = Sheets("Post Launch").Range("A100000").End(xlUp).Row + 1
Sheets("Post Launch").Cells(LastRowConsolidate, 1).Select
ActiveSheet.Paste 'Copier sur la feuille active
Sheets("Master Data").Select
Selection.EntireRow.Delete
Selection.Offset(1, 0).Select


Application.CutCopyMode = False

End If
Next i
Application.ScreenUpdating = True
MsgBox "Le remplacement est terminé", vbOKOnly + vbInformation, "FYI"

End sub


Messages postés
49
Date d'inscription
mercredi 24 août 2016
Statut
Membre
Dernière intervention
26 septembre 2016

Super merci beaucoup ça marche !
Messages postés
154
Date d'inscription
jeudi 4 août 2016
Statut
Membre
Dernière intervention
9 septembre 2016
21
Merci de passer le sujet en résolu :)