macro

[darib52]

bonjour à tous,
voilà bien longtemps que je ne vous ai ennuyé avec mes questions.

j'ai fait une macro qui permet l'archivage dans une feuille "suivi mutuelles" de données saisies sur une ligne dans la feuille "mutuelles"
mon souci est que je peux avoir au maxi 25 lignes à copier.
comment puis-je faire pour faire tourner la macro sur chacune des lignes complétées, sachant que si une donnée figure à minima dans la 1ere colonne, il faut copier la ligne.
suis-je clair ?

merci de vos conseils qui j'imagine sont toujours aussi performants
cordialement.

Sub Archivage()

ici = ActiveSheet.Name: Application.ScreenUpdating = False
Sheets("Suivi Mutuelles").Select
With Sheets("Suivi Mutuelles").UsedRange
i = .Row + .Rows.Count
End With

Sheets("Suivi Mutuelles").Cells(i, 1) = Sheets("Mutuelles").Cells(6, 1).Value
Sheets("Suivi Mutuelles").Cells(i, 2) = Sheets("Mutuelles").Cells(6, 2).Value
Sheets("Suivi Mutuelles").Cells(i, 3) = Sheets("Mutuelles").Cells(6, 3).Value
Sheets("Suivi Mutuelles").Cells(i, 4) = Sheets("Mutuelles").Cells(6, 4).Value
Sheets("Suivi Mutuelles").Cells(i, 5) = Sheets("Mutuelles").Cells(6, 5).Value
Sheets("Suivi Mutuelles").Cells(i, 6) = Sheets("Mutuelles").Cells(6, 6).Value
Sheets("Suivi Mutuelles").Cells(i, 7) = Sheets("Mutuelles").Cells(6, 7).Value
Sheets("Suivi Mutuelles").Cells(i, 8) = Sheets("Mutuelles").Cells(6, 8).Value
Sheets("Suivi Mutuelles").Cells(i, 9) = Sheets("Mutuelles").Cells(6, 9).Value
Sheets("Suivi Mutuelles").Cells(i, 10) = Sheets("Mutuelles").Cells(6, 6).Value
Sheets(ici).Select: Application.ScreenUpdating = True

End Sub

 

[JBARBE]

Re : macro

Bonjour à tous,

toutes mes excuses mais ma proposition ne fonctionne pas !

bonne soirée !

 

[darib52]

Re : macro

et bien ou je suis très mauvais, et c'est tout à fait possible,
ou la macro ne fonctionne pas.
en pj mon fichier pour test en réel.

encore merci de votre aide

 

[JBARBE]

Re : macro

Peut-être ceci : ( test OK)

Sub Archivagetest()
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
Sheets("Suivi Mutuelles").Range("A2:I65536").ClearContents
For i = 2 To 65536
Sheets("mutuelles").Select
If Cells(i + 4, 1) = "" Then Exit For
 For j = 1 To 9
Sheets("Suivi Mutuelles").Cells(i, j) = Sheets("Mutuelles").Cells(i + 4, j).Value
Next j
Next i
Application.ScreenUpdating = True
End Sub

bonne soirée