Résolu macro copier/coller/suprimer une partie de la ligne/ sur une autre feuille

[marleno]

Bonjour,
Je souhaite créer une MACRO sachant que je n'y connais rien en langage VBA...
Mon fichier et de type :
n° de badge / Nom / date de remise / date de restitution et quelques autre colonnes.

Je vous explique mon fonctionnement :
J'inscris des données dans les cellules de la ligne du badge correspondant;
Lorsque que je saisi une date dans la colonne "date de restitution", je souhaite que cette ligne soit copiée dans une feuille annexe, puis que la ligne de la feuille principale soit effacée, hors le numéro du badge.
Je suis sûre que c'est possible, mais je ne connais pas le langage VBA, lorsque j'essai de m'y plonger cela me parait compliqué et j'ai surtout peur de faire une formule "infinie" qui fasse planter pour toujours mon ordinateur...

Merci beaucoup pour votre aide.

 

[drul]

Salut,
fait "à la main" ce que tu désires, avec l'enregistreur de macro actif, ensuite essaye de modifier un peu ce que tu obtiens pour le généraliser, et quand tu seras coincé reviens ici avec ton code.

 

[marleno]

Salut,
fait "à la main" ce que tu désires, avec l'enregistreur de macro actif, ensuite essaye de modifier un peu ce que tu obtiens pour le généraliser, et quand tu seras coincé reviens ici avec ton code.

Bonjour,
Voici la macro obtenue :

[code="vb]Sub tri_et_archivage()
'
' tri_et_archivage Macro
' 1,tri date restitution reelle 2,copier feuille archives 3,suppression ligne
'

'
ActiveWindow.SmallScroll Down:=-15
Columns("A:L").Select
Range("L1").Activate
ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("E2:E151") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("D2151") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("B2:B151") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("BADGES").Sort
.SetRange Range("A1:L151")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Rows("2:2").Select
Selection.Copy
Sheets("archives2").Select
ActiveSheet.Paste
Sheets("BADGES").Select
Range("B2:I2").Select
Application.CutCopyMode = False
Selection.ClearContents
Columns("A:L").Select
Range("L1").Activate
ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("E2:E151") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("D2151") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("B2:B151") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("BADGES").Sort
.SetRange Range("A1:L151")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub[/code]

Voici l'erreur constatée : lorsque je souhaite effectuer une seconde archive (c'est à dire lancer une seconde fois la macro sur une ligne différente de la feuille principale nommée "BADGES"), l'archive est créée comme demandé sur la feuille "archives2", mais "sur" la ligne archivée auparavant, c'est à dire qu'elle efface les données archivées auparavant.
C'est cela que je souhaiterai éviter. Je voudrais que l'archive se fasse au fur et à mesure, sous la ligne créée auparavant...
Suis-je assez claire ?
Merci

 

[drul]

Vraiment besoin de tous ces tri à l'intérieur de la macro ?
Selon ce que tu demandes au départ, la partie intéressante du code est:

 Rows("2:2").Select ' sélection de la ligne à coller
    Selection.Copy ' copie des données dans le presse papier (une hérésie soit dit en passant, mais on s'en occupera plus tard)
    Sheets("archives2").Select 'Selection de la destination (c'est ici qu'il faut travailler pour pouvoir exécuter à nouveau la macro)
    ActiveSheet.Paste 'On copie les donées
    Sheets("BADGES").Select 'retour sur la page de départ
    Range("B2:I2").Select 'Sélection des cases à effacer
    Application.CutCopyMode = False 'truc bizzare de l'enregistreur de macro ...
    Selection.ClearContents 'On efface le contenu des cellule sélctionnée

C'est bien cela ?

 

[marleno]

Vraiment besoin de tous ces tri à l'intérieur de la macro ?
Selon ce que tu demandes au départ, la partie intéressante du code est:

 Rows("2:2").Select ' sélection de la ligne à coller
    Selection.Copy ' copie des données dans le presse papier (une hérésie soit dit en passant, mais on s'en occupera plus tard)
    Sheets("archives2").Select 'Selection de la destination (c'est ici qu'il faut travailler pour pouvoir exécuter à nouveau la macro)
    ActiveSheet.Paste 'On copie les donées
    Sheets("BADGES").Select 'retour sur la page de départ
    Range("B2:I2").Select 'Sélection des cases à effacer
    Application.CutCopyMode = False 'truc bizzare de l'enregistreur de macro ...
    Selection.ClearContents 'On efface le contenu des cellule séelctionnée

C'est bien cela ?

C'est bien cela.
Les tris permettent un visuel simplifié pour moi, mais aussi permettent que l'archivage (de la macro) soit toujours au même endroit.
En gros soit je fais le tri et la macro sélectionne toujours la deuxième ligne à archiver.
Soit je ne fais pas le tri et je dois rajouter à la macro une condition "si la cellule de la colonne H est renseigné, alors on copie toute la ligne de la cellule H renseignée"... ça rajoute une condition sur la macro = chose que je ne sais pas faire.. je fais avec mes moyens

Donc si je dois modifier quelque chose, c'est sur cette partie là :
[ Sheets("archives2").Select 'Selection de la destination (c'est ici qu'il faut travailler pour pouvoir exécuter à nouveau la macro) ]
Je suis censée rajouter une condition : à copier en dessous des archives déjà saisies, sans effacer de données anciennes.
Quelle est cette fonction magique ?

 

[drul]

essaye

Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Select

NB. si la feuille archives2 est vide, un petit bug fera que tu copieras les données dans la deuxièmes ligne, on peut évidement le corrigé si nécessaire, mais ça complique un peu le code ...

 

[marleno]

essaye

Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Select

NB. si la feuille archives2 est vide, un petit bug fera que tu copieras les données dans la deuxièmes ligne, on peut évidement le corrigé si nécessaire, mais ça complique un peu le code ...

résultat :
"erreur d'exécution 438
propriété ou méthode non gérée par cet objet"
je retrouve :
ma ligne bien copiée dans la feuille d'archive.
Je n'ai pas :
- je ne reviens pas sur la feuille principale (ça c'est pas grave, voire mieux finalement)
- la ligne renseignée sur la feuille principale n'est plus effacée.
Pourtant :
Il y a déjà des lignes dans ma feuille d'archive.

 

[drul]

Ok, ma faute ...
(le code pondu par l'enregistreur est tellement mauvais que j'en ai oublié qqch)

rajoute:

Sheets("archives2").Activate

juste avant la ligne que j'ai mis ci-dessus

 

[marleno]

Ok, ma faute ...
(le code pondu par l'enregistreur est tellement mauvais que j'en ai oublié qqch)

rajoute:

Sheets("archives2").Activate

juste avant la ligne que j'ai mis ci-dessus

Même erreur ?
Quand je clique sur "débogage", j'ai la première ligne que tu m'as dis de rajouter en jaune..

 

[drul]

repost le code stp ...

 

[marleno]

repost le code stp ...

Sub tri_et_archive_test2()
'
' tri_et_archive_test2 Macro
'

'
    Columns("A:M").Select
    Range("M1").Activate
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("E2:E151") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("D2:D151") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add(Range("C2:C151"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(123, _
        241, 253)
    With ActiveWorkbook.Worksheets("BADGES").Sort
        .SetRange Range("A1:M151")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("2:2").Select
    Selection.Copy
    Sheets("archives2").Select
    Sheets("archives2").Activate
    Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Range("A29").Select
    ActiveSheet.Paste
    Sheets("BADGES").Select
    Range("B2:I2").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Columns("A:M").Select
    Range("M1").Activate
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("E2:E151") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("D2:D151") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add(Range("C2:C151"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(123, _
        241, 253)
    With ActiveWorkbook.Worksheets("BADGES").Sort
        .SetRange Range("A1:M151")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B3").Select
End Sub

 

[drul]

Essaie ça:

Sub tri_et_archive_test2()
'
' tri_et_archive_test2 Macro
'
 
'
    Columns("A:M").Select
    Range("M1").Activate
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("E2:E151") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("D2:D151") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add(Range("C2:C151"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(123, _
        241, 253)
    With ActiveWorkbook.Worksheets("BADGES").Sort
        .SetRange Range("A1:M151")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("2:2").Select
    Selection.Copy
    Sheets("archives2").Select
    Sheets("archives2").Activate
    Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets("BADGES").Select
    Range("B2:I2").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Columns("A:M").Select
    Range("M1").Activate
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("E2:E151") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("D2:D151") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add(Range("C2:C151"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(123, _
        241, 253)
    With ActiveWorkbook.Worksheets("BADGES").Sort
        .SetRange Range("A1:M151")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B3").Select
End Sub

 

[marleno]

super super super !!!!
ça marche !
l'archivage se fait bien sous la ligne précédemment archivée...
Merci beaucoup pour le temps que tu m'as consacré, l'aide que tu m'as apporté et l'attention que tu m'as accordé...
Ta macro et tes explications précédentes vont me permettre de m'y plonger dedans afin de la comprendre intégralement et de l'apprivoiser pour de nouveaux documents.
Merci encore pour ton aide.
à bientôt

 

[drul]

On pourrait si tu le temps optimiser un peu tout ça ...

p. ex

    Rows("2:2").Select
    Selection.Copy
    Sheets("archives2").Select
    Sheets("archives2").Activate
    Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste

se remplace avantageusement par:

Sheets("BADGES").Rows("2:2").Copy Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)

Et il y en a bien d'autre comme ça.

Si tu le désires, je peux t'expliquer comment exécuter ta macro quand tu rentre ta valeur dans la colonne date sans avoir besoin de trier ...

 

[marleno]

On pourrait si tu le temps optimiser un peu tout ça ...

p. ex

    Rows("2:2").Select
    Selection.Copy
    Sheets("archives2").Select
    Sheets("archives2").Activate
    Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste

se remplace avantageusement par:

Sheets("BADGES").Rows("2:2").Copy Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)

Et il y en a bien d'autre comme ça.

Si tu le désires, je peux t'expliquer comment exécuter ta macro quand tu rentre ta valeur dans la colonne date sans avoir besoin de trier ...

Je suis complètement preneuse !
Le fait d'enlever le tri et d'exécuter la macro dès que la date de restitution est saisie me permettrai de bloquer les cellules et ainsi protéger le classeur en empêchant la suppression des n° de badges !

et ta formule de remplacement :

    Rows("2:2").Select
    Selection.Copy
    Sheets("archives2").Select
    Sheets("archives2").Activate
    Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste

se remplace avantageusement par:

Sheets("BADGES").Rows("2:2").Copy Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)

j'aimerais l'utiliser mais la comprendre avant...

 

[drul]

Pour l'explication:

Range.Select
Selection.copy
C'est plus court d'écrire : Range.copy
Ensuite la fonction copy peut être utilisée de 2 manière:
1)
Range(Source).copy ' mais le contenu de range dans le presse papier
Range(Target).Select 'Selectionne la destination
ActiveSheet.Paste Colle le contenu du presse papier dans la destination

2)
Range(Source).copy Range(Target) ' copie directement Source sur Target, SANS passer par le presse papier

La méthode 2 est fortement recommandée (elle évite de vider des données qui pourrait importante et contenue dans le presse papier en plus d'être plus compact et facile à lire)

 

[drul]

Pour l'appel d'une macro à chaque changement de date:

Vous devez être connecté pour voir les liens.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then 'on s'assure qu'une seule cellule soit modifier
        If Target.Column = 4 And Target.Value <> "" Then ' Si l'a cellule est dans la colonne D (donc 4) et que la valeur est non nulle (pour ne rien faire lors de l'effacement)
            MsgBox Target.Row & " " & Target.Column & " :" & Target.Value 'Alors on fait quelquechose (ici un exemple bidon) !
        End If
    End If
End Sub

Je te laisse essayer ce code et le modifier selon tes besoins. reviens nous faire part de tes problèmes ou de ta solution

 

[marleno]

Pour l'explication:

Range.Select
Selection.copy
C'est plus court d'écrire : Range.copy
Ensuite la fonction copy peut être utilisée de 2 manière:
1)
Range(Source).copy ' mais le contenu de range dans le presse papier
Range(Target).Select 'Selectionne la destination
ActiveSheet.Paste Colle le contenu du presse papier dans la destination

2)
Range(Source).copy Range(Target) ' copie directement Source sur Target, SANS passer par le presse papier

La méthode 2 est fortement recommandée (elle évite de vider des données qui pourrait importante et contenue dans le presse papier en plus d'être plus compact et facile à lire)

d'accord merci pour ces explications.
Et, si, à la place d'avoir un raccourci clavier (Ctrl+a) pour lancer la macro, je voudrais une case style formulaire "archiver" où lorsque qu'on clique dessus la macro est lancée ?

 

[drul]

C'est bien sur possible. il suffit de rajouter un bouton et de lui affecter ta macro
Mais as-tu essayer la méthode décrite ci-dessus ?

 

[marleno]

Pour l'appel d'une macro à chaque changement de date :
mes questions diverses :
- pourquoi aller sur "Microsoft Excel Objets" et non pas sur "Modules"? c'est parce que cela rajoute une condition sur une macro déjà existante ?
- j'ai saisi la formule que tu m'a donné pour rajouter une condition. (j'ai même changé toute seule la colonne car j'en ai ajouté une depuis! *fière).
Mais, je n'ai pas de changement lorsque je saisi une date.
Ai-je oublié qqe chose ?