Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Amélioration du code avec une boucle

Créer une discussion
  • 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
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
Identifiez-vous ou inscrivez-vous pour participer.
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
164
vazvaz
V
U
  • Question Question
Autres Quelques fois ça bug feuilles cachées
Réponses
2
Affichages
169
cathodique
T
  • Question Question
XL 2013 Impression, choix de feuilles et nombre de copie
Réponses
11
Affichages
613
AtTheOne
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
348
patricktoulon
X
  • Question Question
XL 2021 Transformation de données sur une ligne en plusieurs lignes
Réponses
9
Affichages
405
xavieralvaro
X
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
653
ph.vanne
U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
505
un internaute
U
X
  • Question Question
Microsoft 365 compte à rebours avec application.OnTime (Résolu)
Réponses
9
Affichages
193
xabino
X
A
  • Question Question
XL pour MAC Problème avec une macro dupliquant une feuille contenant une macro
Réponses
8
Affichages
253
AlineJ
A
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
778
Phil69970
  • Résolu(e)
XL 2019 macro avec fonction copié coller si rempli par la macro
Réponses
12
Affichages
424
AtTheOne
  • Résolu(e)
XL 2019 colorer les différents aliments avec un code VB pour macro de ce genre ?
2
Réponses
16
Affichages
234
anthoYS
  • Résolu(e)
XL 2010 amélioration code
Réponses
3
Affichages
192
jeanmi
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
647
thunder23
C
  • Résolu(e)
XL 2021 Macro pour mise en page
Réponses
11
Affichages
743
candido57
C
U
  • Question Question
Autres [RÉSOLU] Compléter macro pour Suppr cellules
Réponses
7
Affichages
333
un internaute
U
H
  • Question Question
XL 2013 Erreur VBA 1004 Impression zone d'impression tableau
Réponses
13
Affichages
574
Helios77
H
U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
567
un internaute
U
N
  • Résolu(e)
Microsoft 365 Macro enregistrement automatique pdf
2
Réponses
18
Affichages
685
Nounours4173
N
  • Résolu(e)
XL 2019 Modifier ce code pour de sorte à y rajouter un commentaire après clic droit en colonne I (9) à préremplir mais vierge ?
Réponses
8
Affichages
63
anthoYS
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…