XL 2019 Amélioration du code avec une boucle

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
F

Fanrs

XLDnaute Nouveau
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
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

Discussions similaires

ph.vanne
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
395
ph.vanne
ph.vanne
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
280
Phil69970
Phil69970
C
  • Résolu(e)
XL 2021 Macro pour mise en page
Réponses
11
Affichages
487
candido57
C
H
  • Question
XL 2013 Erreur VBA 1004 Impression zone d'impression tableau
Réponses
13
Affichages
320
Helios77
H
N
  • Résolu(e)
XL 2021 comment faire recherche dans une colonne et ligne
Réponses
5
Affichages
347
job75
job75
cp4
  • Question
XL 2010 [RESOLU] Lenteur rendre visible un Label
Réponses
11
Affichages
331
patricktoulon
patricktoulon
Cédric06400
  • Résolu(e)
Microsoft 365 Déplacement Shape
Réponses
2
Affichages
177
Cédric06400
Cédric06400
M
  • Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
16
Affichages
671
Phil69970
Phil69970
P
  • Question
Microsoft 365 Macro qui plante exel
Réponses
1
Affichages
433
mapomme
mapomme
N
  • Résolu(e)
Microsoft 365 Aide pour terminer un code Vba Excel
2
Réponses
23
Affichages
941
job75
job75

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 42 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 771
Messages
2 112 768
Membres
111 653
dernier inscrit
Vanie0082