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

M

marleno

Habitué


Oui j'ai fais ce que tu as dis.
je te copie colle
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 modifiée
If Target.Column = 5 And Target.Value <> "" Then
'Si la cellule est dans la colonne E (donc 5) 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 Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

tout ça est dans VBAProject (PERSONAL.XLSB) / Microsoft Excel Objets / Feuil1 (Feuil1) puis Worksheet / Change.

Autre question, j'ai créé le bouton "archiver", et j'y ai affecté ma macro.
J'ai cliqué pour le tester plusieurs fois... Cela a archivé du coup mes lignes au fur et à mesure.
Ma question est : est-il possible de bloquer la macro si la date dans la colonne 5 (elle a changé) n'est pas renseignée ?
Faire un message d'alerte genre "attention, vous ne pouvez pas archiver tant que la date de restitution réelle n'est pas renseignée "...
Merci
 
drul

drul

Obscur pro du hardware
Staff
Par date non renseigné, tu endends cellule vide ?
si oui, alors
Code: 
 if cells(x,y).Value ="" then 
  MsgBox  "attention, vous ne pouvez pas archiver tant que la date de restitution réelle n'est pas renseignée "
else
 'ta macro de copie
end if
 
M

marleno

Habitué

Ca marche super !
Du coup j'ai renseigné la cellule (5; 2).
Du coup, Est-ce que je peux, plutôt que de renseigner la cellule, faire une recherche pour toute la colonne E : c'est à dire sur 60 lignes, il y en a 4 que je viens de modifier en ajoutant une date.
Je souhaite cliquer sur mon bouton "archiver", et je voudrais que les 4 lignes saisies s'archivent (selon ma macro).
J'imagine que c'est possible ?
Si oui, du coup je n'aurai plus besoin de trier mes colonnes !
 
drul

drul

Obscur pro du hardware
Staff
Si mon souvenir est exact la colonne A contient le n° de badge et n'est jamais vide, c'est bien ça ?

Code: 
Sub boucle()
Dim derLigne As Long
Dim i As Long

derLigne = Sheets("BADGES").Cells(Sheets("BADGES").Rows.Count, 1).End(xlUp).Row ' on determine la fin de ton tableau

For i = 1 To derLigne 'boucle qui regarde chaque ligne
    If Cells(i, 5).Value <> "" Then ' si la date est non nulle
         'ta macro de copie
    End If
Next

End Sub
 
M

marleno

Habitué
J'ai du mal bidouiller ça ne marche plus...
faut que je pense à changer mes macros avant de les modifier...
est ce là mon erreur :
j'ai écris
SUB boucle ()
[...]
Else
Sub tri_et_archive()
[...]
End Sub
End Sub

Je pense que je me suis emmêlé les pinceaux.
Et puis, du coup, peut être que ça ne marche pas car je n'ai pas enlevé mon tri ?

 
drul

drul

Obscur pro du hardware
Staff
faut un end sub avant de commencer une nouvelle sub

SUB boucle ()
[...]
Else
End Sub
Sub tri_et_archive()
[...]
End Sub
 
M

marleno

Habitué


Du coup il me manque le "else" quelque part dans ma fonction sub boucle().
j'ai intégré cette fonction Sub_Boucle() avant ma fonction tri_archivage()
Lorsque je saisi une date de restitution en milieu de tableau il m'affiche la fenêtre bloquante (pas d'archivage si pas de date renseignée) alors qu'elle est renseignée. Il ne faudrait pas qu'il y ai la fonction boucle au milieu de ma fonction tri et archive ?
Ou sinon que j'enlève tout mes tris dans la macro ?
 
M

marleno

Habitué

Code: 
Sub boucle()

Dim derLigne As Long

Dim i As Long

 
derLigne = Sheets("BADGES").Cells(Sheets("BADGES").Rows.Count, 1).End(xlUp).Row
'on determine la fin du tableau

For i = 1 To derLigne
'boucle qui regarde chaque ligne

End Sub
Sub tri_et_archivage_test3()
 '
 ' tri_et_archive_test3 Macro
 '
  If Cells(5, 2).Value = "" Then
'si la date est non nulle

 MsgBox "attention, vous ne pouvez pas archiver tant que la date de restitution réelle n'est pas renseignée "

Else

 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").Copy
   'selection de la ligne puis copie (remplace fonction Rows(ou)Range.Select Selection.Copy c'est plus court d'écrire : Range.copy et on utilise plus de presse papier)
 Sheets("archives2").Select
  'selection de la destination
 Sheets("archives2").Activate
 Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
 ' fait en sorte que l'archivage se fasse après l'archivage précédent
 ActiveSheet.Paste
 ' copie des données
 Sheets("BADGES").Select
 'retour sur la page de départ
 Range("B2:I2").Select
 'sélection des cases à effacer
 Application.CutCopyMode = False
  'truc bizarre de l'enregistreur de la macro
 Selection.ClearContents
  'efface contenu des cellules selectionnées
 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
 'tri colonne
 ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add Key:=Range("D2:D151") _
 , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 'tri colonne
 ActiveWorkbook.Worksheets("BADGES").Sort.SortFields.Add(Range("C2:C151"), _
 xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(123, _
 241, 253)
 'tri colonne
 With ActiveWorkbook.Worksheets("BADGES").Sort
 .SetRange Range("A1:M151")
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
 Range("B3").Select
 End If
 
End Sub
 
drul

drul

Obscur pro du hardware
Staff
Oula, tu as bien tout mélanger la en effet :D ...
Bon aller le résultat propre:

Code: 
Sub Archivage()
 
Dim derLigne As Long
Dim i As Long
 
derLigne = Sheets("BADGES").Cells(Sheets("BADGES").Rows.Count, 1).End(xlUp).Row
'on determine la fin du tableau
 
For i = 1 To derLigne
'boucle qui regarde chaque ligne
  If Sheets("BADGES").Cells(i, 5).Value <> "" Then
    'on copie
    Sheets("BADGES").Cells(i, 1).EntireRow.Copy _
    Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
    'on efface
    Range("B" & i & ":I" & i).ClearContents
  End If
Next
End Sub
 
M

marleno

Habitué

Merci... Je me suis un peu trop emballée à ce que je vois.
Du coup sur ta fonction, j'ai voulu intégrer la fonction de la boite de message :
If Cells(5, 2).Value = "" Then
'si la date est non nulle

MsgBox "attention, vous ne pouvez pas archiver tant que la date de restitution réelle n'est pas renseignée "
End If
Je pense que je l'ai mise au mauvais endroit car j'ai tout fait planter l'ordi m'affichait sans cesse la boite de dialogue du msg bloquant.
je l'avais mise avant la fonction if<>""
Faut-il que je la mette après ?
après "End If" et avant "Next" ?
Ou après "Next" ?
 
M

marleno

Habitué

Bon j'ai essayé d'y intégrer la fonction du message bloquant mais voilà encore une fois il y a des erreurs que je n'arrive pas à corriger...
Je ne désespère pas mais je crois que je vais arrêter d'essayer par moi même...
Voici ma saisi :
Sub Archivage()

Dim derLigne As Long

Dim i As Long

derLigne = Sheets("BADGES").Cells(Sheets("BADGES").Rows.Count, 1).End(xlUp).Row
'on determine la fin du tableau

For i = 1 To derLigne
'boucle qui regarde chaque ligne

If Sheets("BADGES").Cells(i, 5).Value = "" Then

MsgBox "attention, vous ne pouvez pas archiver tant que la date de restitution réelle n'est pas renseignée "

Else

'on copie
Sheets("BADGES").Cells(i, 1).EntireRow.Copy Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
'on efface
Range("B" & i & ":I" & i).ClearContents

End If

Next
End Sub
 
drul

drul

Obscur pro du hardware
Staff
1) Pourquoi veut tu faire un message si tu boucle sur tous les éléments ?
2) c'est quoi l'erreur ? Chez moi ta macro passe.
p.s
entoure ton code des balise code stp
[code="vb"]
...
ton code
[/code]
 
M

marleno

Habitué


Je voudrais faire un message car le fichier ne serait pas pour moi et je pense que les personnes qui vont l'utiliser ne comprennent rien à "l'automatisation"...
Je te retransmet la macro mais je suis pas sure de savoir l'entourer des balises:
Code: 
Sub Archivage()

 Dim derLigne As Long

 Dim i As Long

 derLigne = Sheets("BADGES").Cells(Sheets("BADGES").Rows.Count, 1).End(xlUp).Row
 'on determine la fin du tableau

 For i = 1 To derLigne
 'boucle qui regarde chaque ligne

 If Sheets("BADGES").Cells(i, 5).Value = "" Then

 MsgBox "attention, vous ne pouvez pas archiver tant que la date de restitution réelle n'est pas renseignée "

 Else

 'on copie
 Sheets("BADGES").Cells(i, 1).EntireRow.Copy Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
 'on efface
 Range("B" & i & ":I" & i).ClearContents

 End If

 Next
 End Sub
 
drul

drul

Obscur pro du hardware
Staff
et c'est quoi le problème ? (tu as réussi our les balises ;))
 
M

marleno

Habitué


Oui j'ai vu !!
Le problème est que :
quand j'ai saisi une date et que je clique sur le bouton d'archivage, la fenêtre s'affiche alors qu'il y a une date dans ma cellule, et j'ai beau cliquer sur "ok" la fenêtre s'affiche indéfiniment...
je force l'arrêt.
 
drul

drul

Obscur pro du hardware
Staff
La macro parcours tout ton tableau, pour chaque ligne n'ayant pas de date, elle t'affichera un pop-up ...
Est-ce vraiment ce que tu désires ? (ou préférerais-tu un message si AUCUNE ligne n'a de date ?).
Les dates sont bien en colonne "E" ?
 
M

marleno

Habitué


Oui je préfèrerais un message si aucune ligne n'a de date...
Oui les dates sont bien en colonne E.
 
drul

drul

Obscur pro du hardware
Staff
Meilleure réponse
Code: 
Sub Archivage2()

Dim derLigne As Long
Dim i As Long
Dim nbLigneArchive As Long

derLigne = Sheets("BADGES").Cells(Sheets("BADGES").Rows.Count, 1).End(xlUp).Row
'on determine la fin du tableau
nbLigneArchive = 0
For i = 1 To derLigne
'boucle qui regarde chaque ligne

    If Sheets("BADGES").Cells(i, 5).Value <> "" Then
        'on copie
        Sheets("BADGES").Cells(i, 1).EntireRow.Copy _
        Sheets("archives2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
        
        'on efface
        Range("B" & i & ":I" & i).ClearContents
        nbLigneArchive = nbLigneArchive + 1
    End If
Next
If nbLigneArchive = 0 Then
    MsgBox "attention, vous ne pouvez pas archiver tant que la date de restitution réelle n'est pas renseignée "
Else
    MsgBox nbLigneArchive & " ligne(s) archivée(s) avec succès"
End If
End Sub
 
M

marleno

Habitué

Quel luxe !
Dernier petit problème : l'archivage de mes en tète de colonne est fait à chaque fois du coup... (avec effacement)
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Dernières actus
Derniers messages publiés
Statistiques globales
Discussions
730 167
Messages
6 718 783
Membres
1 586 467
Dernier membre
yusuke_uramishi
Partager cette page
Haut