Macro excel => Boucle

Résolu/Fermé

Keny - 25 mai 2010 à 16:48
Keny - 27 mai 2010 à 08:53

Bonjour,

j'ai effectué une macro excel permettant de déplacer une ligne si une condition est remplie.
je voudrais rajouter une boucle à ma macro pour qu'elle passe en revue toute les lignes de mon tableau ....

Voici ma macro :

Sub archivage()

Dim ligne_active_base As Double

Sheets("suivi").Select
If Range("H3").Value = "F" Then

'Test pour déterminer la ligne où coller les infos dans le tableau'
Sheets("archive").Activate

'Mémorise le n° de la ligne où coller les données'
If Range("A3").Value = "" Then
ligne_active_base = Range("A3").Row
Else
ligne_active_base = Range("A3").End(xlDown).Row + 1
End If

'Atteindre le formulaire et mémoriser les données'
Sheets("suivi").Range("B3:H3").Copy
Range("A" & ligne_active_base).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Collage sans transposition'
Application.CutCopyMode = False
Range("G3").ClearContents

'Rendre le formulaire vierge'
Sheets("suivi").Activate
Sheets("suivi").Range("B3:H3").ClearContents
Sheets("suivi").Range("B3").Select

'Retourner sur la base de données'
Sheets("archive").Activate

End If

End Sub

Cette macro traite seulement la ligne 3 (B3:H3) de mon tableau ...
je voudrais que la boucle réitère l'opération pour les lignes 3 à 21 (B21:H21)

Merci d'avance de votre aide

Cordialement,
Keny

A voir également:

Boucle excel sans macro
Liste déroulante excel - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Formule excel - Guide
Macro word - Guide
Si et excel - Guide

1 réponse

Réponse 1 / 1

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
25 mai 2010 à 23:56

bonjour

Je te propose ceci qui devrait faire ce que tu souhaites :

Sub archivage()

Dim lignes As Object
For Each lignes In Sheets("suivi").Columns("H").Cells
    If lignes.Value = "F" Then
        Sheets("suivi").Cells(lignes.Row, 2).Resize(1, 6).Copy
        Sheets("archive").Cells(Range("A65532").End(xlUp).Row + 1, 1).PasteSpecial _
        Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Sheets("suivi").Cells(lignes.Row, 2).Resize(1, 7).ClearContents
    End If
Next lignes
Application.CutCopyMode = False
End Sub

tu sélectionnes toutes les lignes avec "F" en colonne H et tu les archives.

Keny
26 mai 2010 à 08:36

Bonjour,

jai testé ta solution, elle me semble judicieuse. seul problème, si j'ai selectionné 4 ligne avec le "F" , elle me les déplace dans archive, mais toutes sur la meme ligne ... donc la derniere écrase tout le reste ...

je voudrais que dans "archive" qu'il colle les données a partir de "A3" , en passant par "A4" si A3 n'est pas vierge.

merci !

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
26 mai 2010 à 09:51

bonjour,

Ta feuille archive n'ai pas bien enregistrée : tu as des lignes vides après tes données.

Il faut les sélectionner en te mettant sur la première puis faire majuscule + ctrl + fin et clic droit supprimer puis tu sauvegardes, tu fermes et tu recommences, cela devrait fonctionner.

Keny
26 mai 2010 à 11:11

Bonjour,

j'ai essayé cke tu m'a dit de faire, mais ca change rien ...
je t'envoie le lien ca sera plus simple ...
dans l'onglet suivi ta un onglet "archivage" ki permet d'executer la macro.

http://www.cijoint.fr/cjlink.php?file=cj201005/cij4f7Vg7U.xls

Merci

Keny
26 mai 2010 à 11:35

dsl jvoulai dire, un boutton "archivage"

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
Modifié par gbinforme le 26/05/2010 à 23:27

bonsoir,

Au temps pour moi, il manque une qualification et il faut rajouter le paramètre gras

        Sheets("archive").Cells(Sheets("archive").Range("A65532").End(xlUp).Row + 1, 1).PasteSpecial _ 
        Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

ou plus correct et simple

Sub archivage()
Dim lignes As Object
Application.ScreenUpdating = False
With Sheets("archive")
For Each lignes In Sheets("suivi").Columns("H").Cells
    If lignes.Value = "F" Then
        Sheets("suivi").Cells(lignes.Row, 2).Resize(1, 6).Copy
        .Cells(.Range("A65532").End(xlUp).Row + 1, 1).PasteSpecial _
        Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Sheets("suivi").Cells(lignes.Row, 2).Resize(1, 7).ClearContents
    End If
Next lignes
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro

Discussions similaires

Newsletters