Macro excel => Boucle

Résolu

Keny -
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

Afficher la suite

A voir également:

Boucle excel sans macro
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Liste déroulante excel - Guide
Word et excel gratuit - Guide
Déplacer colonne excel - Guide
Si ou excel - Guide

1 réponse

Réponse 1 / 1

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

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

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 Statut Contributeur Dernière intervention 4 724

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

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

dsl jvoulai dire, un boutton "archivage"

gbinforme Messages postés 14946 Date d'inscription Statut Contributeur Dernière intervention 4 724

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

Votre réponse

Discussions similaires