XL 2019 Amélioration du code avec une boucle

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
...

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 !
 

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. :)
 

Discussions similaires