Mettre fin à la macro quand cellule vide

Bonjour le forum,

Qui peut simplifier ma macro avec une boucle ?

voilà j'ai créé une macro (cf. fichier joint) mais elle est longue et je souhaiterais faire une boucle afin de lancer la mise à jour dans plusieurs lignes et pas seulement les 5 premières.

Sub impression()
'
' impression Macro
'
    Sheets("Liste").Select
    Range("N2:Q2").Select
    Selection.Copy
    Sheets("A4 Soldes").Select
    Range("AQ3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AR12").Select
    ActiveWorkbook.PrintOut
    Sheets("Liste").Select
    Range("N3:Q3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("A4 Soldes").Select
    Range("AQ3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AR13").Select
    ActiveWorkbook.PrintOut
    Sheets("Liste").Select
    Range("N4:Q4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("A4 Soldes").Select
    Range("AQ3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AR13").Select
    ActiveWorkbook.PrintOut
    Sheets("Liste").Select
    Range("N5:Q5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("A4 Soldes").Select
    Range("AQ3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AR13").Select
    ActiveWorkbook.PrintOut
    Sheets("Liste").Select
    Range("N6:Q6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("A4 Soldes").Select
    Range("AQ3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AR13").Select
    ActiveWorkbook.PrintOut
End Sub

Merci de votre aide.

Bonjour,

Tout le monde utilise l'enregistreur de macro. Malheureusement celui-ci à tendance à un peu trop décomposer ce qu'il enregistre.

En effet avant de copier quelque chose, quand tu enregistres il faut d'abord sélectionner la bonne feuille puis la bonne plage puis enfin Copier. Toutes ces opérations se soldent par un nombre impressionnant de :

.Select... Selection

La première chose à faire est donc déjà de supprimer tous ces opérations intermédiaires inutiles.

Cette opération faite tu devrais avoir quelque chose comme :

Sub impression()
    Sheets("Liste").Range("N2:Q2").Copy
    Sheets("A4 Soldes").Range("AQ3").PasteSpecial Paste:=xlPasteValues
    ActiveWorkbook.PrintOut
    Sheets("Liste").Range("N3:Q3").Copy
    Sheets("A4 Soldes").Range("AQ3").PasteSpecial Paste:=xlPasteValues
    ActiveWorkbook.PrintOut
    Sheets("Liste").Range("N4:Q4").Copy
    Sheets("A4 Soldes").Range("AQ3").PasteSpecial Paste:=xlPasteValues
    ActiveWorkbook.PrintOut
    Sheets("Liste").Range("N5:Q5").Copy
    Sheets("A4 Soldes").Range("AQ3").PasteSpecial Paste:=xlPasteValues
    ActiveWorkbook.PrintOut
    Sheets("Liste").Range("N6:Q6").Copy
    Sheets("A4 Soldes").Range("AQ3").PasteSpecial Paste:=xlPasteValues
    ActiveWorkbook.PrintOut
End Sub

On y voit déjà plus clair ?

YAPUKA faire la boucle :

Sub impression()
With Sheets("Liste")
   i = .[A1].End(4).Row '(Détermination de la dernière ligne)
   For k = 2 To i
       .Range("N" & k & ":Q" & k).Copy
       Sheets("A4 Soldes").Range("AQ3").PasteSpecial Paste:=xlPasteValues
       ActiveWorkbook.PrintOut
   Next
End With
End Sub

A+

Bonjour et merci de ta réponse, je vais tester.

J'ai utilise l'enregistreur de macro parceque je n'arrivais pas a faire le collage en decalant d'une ligne.

Comme mon nom l'indique, je débute en va

Et ce forum et les cours de se site sont geniaux.

Bonjour,

ça fonctionne mais je voudrais qu'il continue la macro jusqu'à la dernière ligne de la liste.

En sachant que la liste peut contenir 4 lignes comme 10 lignes ou plus.

Merci de votre aide.

Sébastien

Bonjour,

   i = .[A1].End(4).Row '(Détermination de la dernière ligne)

sur cette ligne je peux choisir le nbr de ligne en rajoutant +5 ou +10 suivant mes besoins mais j'aimerais que ça le fasse automatiquement suivant le nombre de ligne rempli.

j'ai éssayé en comptant le nombre de ligne rempli avec :

 Dim NLg As Integer
     NLg = Range("A1").SpecialCells(xlCellTypeLastCell).Row

mais j'y arrive pas... j'ai besoin de votre aide.

Merci par avance.

Sébastien

Bonjour,

YA RIEN à modifier

Ce code détermine la dernière ligne remplie :

 i = .[A1].End(4).Row '(Détermination de la dernière ligne)

A+

Bonjour,

je rencontre un souci :

je créé mon fichier avec ma macro et une liste de 10 lignes, jusque là tout va bien.

Mais si je rajoute une ligne, il ne la prend pas en compte et si j'enlève des lignes, il m'imprime des feuilles vierges jusqu'à atteindre les 10 feuilles.

Je ne vois pas où est le problème.

Bonsoir,

Il faut que tu définisses ta zone d'impression pour lafeuille "A4 Soldes" , tes marges...

Au lieu de :

ActiveWorkbook.PrintOut... mettre

Sheets("A4 Soldes").PrintOut 

Pendant la phase de débogage mettre :

Sheets("A4 Soldes").PrintOut preview:=True

ainsi tu ne gaspilleras pas du papier pour rien... En appuyant sur Echap ça n'imprimera pas.

A+

je me suis mal expliqué, car j'ai bien défini la zone d'impression et j'avais modifié la ligne pour l'impression car j'ai 2 macros suivant la feuille d'impression choisi.

Ci-dessous, le code que j'utilise :

Sub auto_open()
'choix imprimante
Application.Dialogs(xlDialogPrinterSetup).Show
End Sub

Sub impressionA4()
With Sheets("Liste")
   i = .[A1].End(4).Row '(Détermination de la dernière ligne)
  For k = 2 To i
       .Range("N" & k & ":Q" & k).Copy
       Sheets("A4 Soldes").Range("AQ3").PasteSpecial Paste:=xlPasteValues '(collage spécial sur format A4)
       Sheets("A4 Soldes").PrintPreview '(Apperçu avant impression)
   Next
End With
End Sub

Sub impression13x13()
With Sheets("Liste")
   i = .[A1].End(4).Row '(Détermination de la dernière ligne)
  For k = 2 To i
       .Range("N" & k & ":Q" & k).Copy
       Sheets("13x13 Soldes").Range("AQ3").PasteSpecial Paste:=xlPasteValues '(collage spécial sur format 13x13)
       Sheets("13x13 Soldes").PrintPreview '(Apperçu avant impression)
   Next
End With
End Sub

mon seul problème est qu'il ne prend pas en compte le nombre de lignes correspondant réellement au tableau "liste".

Bonjour,

Délà on va déjà tordre le cou à la Sub Auto_Open qui ne devrait plus exister.

Depuis 2007 on utilise :

Private Sub Workbook_Open()
Application.Dialogs(xlDialogPrinterSetup).Show
End Sub

Et cette macro doit être installée dans le Module ThisWorkbook.

Pour le reste je ne comprend pas ton problème :

Tu as demandé une macro qui affiche ligne par ligne le contenu de la première feuille sur la deuxième.

Et c'est bien ce qui est fait : S'il n'y a que 3 lignes, il y a 3 feuilles imprimées avec sur chacune une ligne différente.

S'il y en à 8 tu as 8 impressions avec une ligne également et ce quel que soit le format choisi.

Ce qui correspond également à ce que tu as enregistré.

Préciser le problème parce que là, j'ai un petit coup de vieux...

A+

j'ai repris le fichier de base pour contrôler ligne par ligne et j'ai trouvé d'ou venait mon problème, ça n'avait rien à voir avec la macro, c'est que ma liste réalisée des calculs dans des cellules cachées qui ne se mettait pas à jour et ainsi bloqué les nouvelles lignes.

Il me reste plus qu'à modifier mes calculs pour qu'il supprime les lignes non remplies.

Merci pour tout.

Sébastien.