Histoire de boucle !!!

[BAT]

Bonjour à tous,
J’essaie de finir un fichier qui permet d’automatiser la création de quittance de loyer. Mais je butte sur la boucle. J’ai deux feuilles :
La 1er : j’ai la base avec un nombre de lignes variables. Sur chaque lignes les infos nécessaires pour les quittances.
La 2ème : Le modèle que la quittance de loyer

L’idée c’est que lorsque je lance la macro, cette dernière me créer un nouveau classeur avec toutes les quittances de loyer.

Je suis parti sur la solution suivante qui me semble largement « améliorable » ! mais je ne suis pas expert en VBA !! Je bute sur la boucle. Voilà à quoi je pensais. La boucle fait le travail suivant sur chaque ligne :
1 : copie de la 1er ligne dans la base (ligne 2 de la feuille modèle cellules A2:M2)
2 : Collage spécial (valeur) de la sélection dans la feuille MODEL (ligne 2)
‘le model est programmé et se complète alors tous seul grâce au formules présentes dans les cellules du modèle
3 : Copie de la feuille au sein du même classeur en la renommant du nom du champ REF (M2 dans le modèle)

La boucle réalise cette opération jusqu’à la dernière ligne de la feuille MODEL. Une fois fait, la macro sélectionne toutes les feuilles ainsi créées et en fait un nouveau classeur.

Donc je butte sur la boucle. Voici le code que j’ai déjà fait. Il ne lui manque que la boucle. Please ! HELPPP ! :

   Sheets("MAISON").Select
    Range("A2:M2").Select
    Selection.Copy
    Sheets("MODEL").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("MODEL").Select
    Application.CutCopyMode = False
    Sheets("MODEL").Copy Before:=Sheets(1)
    
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Merci à tous d'avoir lu jusq'ici et merci par avance de votre aide ... si précieuse ! Voici le fichier auuel s'applique la macro.

 

[JCGL]

Re : Histoire de boucle !!!

Bonjour à tous,

Peux-tu essayer avec :

Sub Archivage()
Dim DerL As Integer
Dim X As Integer

Application.ScreenUpdating = 0

DerL = Sheets("Maison").Range("A" & Rows.Count).End(xlUp).Row
For X = 2 To DerL
    Sheets("MAISON").Range("A" & X & ":M" & X).Copy
    Sheets("MODEL").Select
    Range("A2").PasteSpecial Paste:=xlPasteValues
    Sheets("MODEL").Select
    Application.CutCopyMode = False
    Sheets("MODEL").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = Range("K35")
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("A1").Select
Next X
End Sub

A+ à tous

 

[BAT]

Re : Histoire de boucle !!!

Bonjour Jean-Marcel, JCGL,
Un GRAND GRAND merci à tous les deux pour ces deux solutions. Les deux possibilités sont TOP ! J'ai pas encore fait mon choix sur celle que je vais adopter !

Si je peux abuser de vos capacités encore une fois, pourriez vous m'écrire le code qui permet de selectionner toutes les feuilles d'un classeur à l'exception des feuilles nommées "MAISON" et "MODEL".

Merci encore une fois à vous.

 

[BAT]

Re : Histoire de boucle !!!

Re bonsoir,
Pour ma dernière question j'ai un bout de réponse mais il me manque le reste

Dim ws As Worksheet
For Each ws In Worksheets
ws.Select False
Next ws

Cette macro sélectionne toutes les feuilles mais il me manque le bout qui déselectionne les deux feuilles qui m'interresent !!!

 

[Catrice]

Re : Histoire de boucle !!!

Bonsoir BAT,

Tu veux selectionner les feuilles dans quel but ?

 

[JCGL]

Re : Histoire de boucle !!!

Bonjour à tous,
Salut Catrice,

Je suppose que notre ami veut réaliser un archivage des loyers du mois...

Un essai en PJ (j'ai modifié le nom des feuilles)

Sub Archivage()
Dim DerL As Integer
Dim X As Integer
Dim F As Object

Application.ScreenUpdating = 0

DerL = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
For X = 2 To DerL
    Sheets("Data").Range("A" & X & ":M" & X).Copy
    Sheets("Matrice").Select
    Range("A2").PasteSpecial Paste:=xlPasteValues
    Sheets("Matrice").Select
    Application.CutCopyMode = False
    Sheets("Matrice").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = Range("K35")
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("A1").Select
Next X
Sheets("Data").Activate
ActiveWorkbook.Saved = 0
Application.DisplayAlerts = 0
For Each F In Sheets
    If F.Name = "Data" Or F.Name = "Matrice" Then F.Delete
Next
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Archives de " & Format(Date, "yyyymmdd") & ".xls"
'ActiveWorkbook.Close
Application.DisplayAlerts = 1
End Sub

A++
A+ à tous

 

[BAT]

Re : Histoire de boucle !!!

Bonjour à tous,
D'abord désolé de ne pas avoir été clair sur ma dernière demande. En effet, JCGL, tu as bien saisie l'objectif et la finalité ... et ton code est parfait. Merci merci et encore merci à tous pour votre patience et votre aide précieuse.
A bientôt