XL 2019 Amélioration du code avec une boucle

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Fanrs
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
F

Fanrs

XLDnaute Nouveau
Bonjour, je ne suis pas encore à l'aise avec les boucles, est ce que quelqu'un peut m'aider sur ce bout de code ?
Merci d'avance

VB: 
Sub Imprime_Label_SHIP()


Application.ScreenUpdating = False
Sheets("Label SHIP").Visible = True

   
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Sheets("Synthèse").Select
   
If Range("S2") <> "" Then
    Range("S2").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If
       
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    Sheets("Synthèse").Select

If Range("S3") <> "" Then
    Range("S3").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    Sheets("Synthèse").Select

If Range("S4") <> "" Then
    Range("S4").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Sheets("Synthèse").Select
   
If Range("S5") <> "" Then
    Range("S5").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If
       
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    Sheets("Synthèse").Select

If Range("S6") <> "" Then
    Range("S6").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    Sheets("Synthèse").Select

If Range("S7") <> "" Then
    Range("S7").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Sheets("Synthèse").Select
   
If Range("S8") <> "" Then
    Range("S8").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If
       
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    Sheets("Synthèse").Select

If Range("S9") <> "" Then
    Range("S9").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    Sheets("Synthèse").Select

If Range("S10") <> "" Then
    Range("S10").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Sheets("Synthèse").Select
   
If Range("S11") <> "" Then
    Range("S11").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If
       
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    Sheets("Synthèse").Select

If Range("S12") <> "" Then
    Range("S12").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    Sheets("Synthèse").Select

If Range("S13") <> "" Then
    Range("S13").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Sheets("Synthèse").Select
   
If Range("S14") <> "" Then
    Range("S14").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If
       
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    Sheets("Synthèse").Select

If Range("S15") <> "" Then
    Range("S15").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    Sheets("Synthèse").Select

If Range("S16") <> "" Then
    Range("S16").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Sheets("Synthèse").Select
   
If Range("S17") <> "" Then
    Range("S17").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If
       
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    Sheets("Synthèse").Select

If Range("S18") <> "" Then
    Range("S18").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Sheets("Synthèse").Select
   
If Range("S19") <> "" Then
    Range("S19").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If

    Sheets("Synthèse").Select
   
If Range("S20") <> "" Then
    Range("S20").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
   
    Sheets("Label SHIP").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
Else
    Call Appel_total_ship2
    Application.ScreenUpdating = True
    Exit Sub

End If


       
End Sub
 
Dernière édition:
Solution
sylvanu
Peut être en utilisant une boucle qui va de 2 à 20.
Ensuite le bout de code :
VB: 
    Range("S2").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
peut être remplacé par :   
    Range("SHIP_1") = Range("S2").Value
Ce qui pourrait donner :
Code: 
Sub Imprime_Label_SHIP()
Application.ScreenUpdating = False
Sheets("Label SHIP").Visible = True
Sheets("Label SHIP").Select
For i = 2 To 20
    If Cells(i, "S") <> "" Then
        Range("SHIP_1") = Cells(i, "S").Value
        ActiveSheet.PageSetup.Orientation = xlLandscape
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Else
        Call Appel_total_ship2
        Application.ScreenUpdating = True
        Exit Sub
    End If
Next i
End Sub
...
Trier par date Trier par votes
Merci pour votre réponse.

Le code est bon mais pas très propre étant donné qu'il se répète 20 fois avec juste une variable qui est
If Range("S2") <> "" Then
Range("S2").Select
...
et qui descend jusqu'en s20 si non vide

C'était juste pour optimiser et apprendre mais sinon ca marche bien !
 
Vote positif 0 Vote négatif
Peut être en utilisant une boucle qui va de 2 à 20.
Ensuite le bout de code :
VB: 
    Range("S2").Select
    Selection.Copy
    Range("SHIP_1").Select
    ActiveSheet.Paste
peut être remplacé par :   
    Range("SHIP_1") = Range("S2").Value
Ce qui pourrait donner :
Code: 
Sub Imprime_Label_SHIP()
Application.ScreenUpdating = False
Sheets("Label SHIP").Visible = True
Sheets("Label SHIP").Select
For i = 2 To 20
    If Cells(i, "S") <> "" Then
        Range("SHIP_1") = Cells(i, "S").Value
        ActiveSheet.PageSetup.Orientation = xlLandscape
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Else
        Call Appel_total_ship2
        Application.ScreenUpdating = True
        Exit Sub
    End If
Next i
End Sub
Evidemment non testé.

PS : Changez le titre du post qui ne correspond pas à la requête. Pensez aux lecteurs futurs. 🙂
 
Vote positif 0 Vote négatif
Solution
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

V
  • Question Question
XL 2016 transformer en boucle une macro créer avec l'enregistreur automatique
Réponses
3
Affichages
50
vazvaz
V
ph.vanne
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
455
ph.vanne
ph.vanne
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
377
Phil69970
Phil69970
C
  • Résolu(e)
XL 2021 Macro pour mise en page
Réponses
11
Affichages
552
candido57
C
H
  • Question Question
XL 2013 Erreur VBA 1004 Impression zone d'impression tableau
Réponses
13
Affichages
366
Helios77
H
jeanmi
  • Résolu(e)
XL 2010 amélioration code
Réponses
3
Affichages
82
jeanmi
jeanmi
B
  • Question Question
XL 2019 Dans une macro de démarrage de fichier masquer le code par des Astérix ou point
Réponses
3
Affichages
68
sylvanu
sylvanu
N
  • Résolu(e)
XL 2021 comment faire recherche dans une colonne et ligne
Réponses
5
Affichages
412
job75
job75
J
  • Question Question
Microsoft 365 Probléme VBA
Réponses
8
Affichages
213
jalaba
J
Cédric06400
  • Résolu(e)
Microsoft 365 Déplacement Shape
Réponses
2
Affichages
206
Cédric06400
Cédric06400
F
  • Question Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
332
Oneida
Oneida
P
  • Question Question
Microsoft 365 Macro qui plante exel
Réponses
1
Affichages
465
mapomme
mapomme
P
  • Question Question
XL 2021 Ajout/adaptation de code VBA sur feuille qui en contient déjà
Réponses
3
Affichages
71
Pierreavecunp
P
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
192
patricktoulon
patricktoulon
cp4
  • Question Question
XL 2010 [RESOLU] Lenteur rendre visible un Label
Réponses
11
Affichages
389
patricktoulon
patricktoulon
N
  • Résolu(e)
Microsoft 365 Aide pour terminer un code Vba Excel
2
Réponses
23
Affichages
1 K
job75
job75
M
  • Question Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
17
Affichages
877
MICHAEL
M
S
  • Question Question
XL 2021 Afficher et masquer des colonnes
Réponses
3
Affichages
431
job75
job75
E
  • Résolu(e)
XL 2019 transfer listbox vers une colonne à partir de la 4 ligne
Réponses
2
Affichages
152
escudo
E
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
185
sebastien176
S
Retour