Impression de plusieurs étiquettes

bonjour à tous ,

J'ai ce code de Scorpio RG pour imprimer des étiquettes qui fonctionne mais je voudrais le modifier pour permettre d'imprimer plusieurs étiquettes sur la même page ? est ce possible?

  Dim VarNbImpession As String 'Nombre de copies
    Dim LgImp As Long

    LgImp = ActiveCell.Row 'N° de ligne

    'Vérifi que la ligne selectioner soit bien dans la plage du tableau
    If LgImp < 7 Then
    MsgBox "Selection invalide"
    Exit Sub
    End If

   VarNbImpession = InputBox("Veuilliez définir le nombre de copies", "Nombre d'impression") 'La variable reçoit la valeur entrée dans l'InputBox

        'Verification sur la variable VarNbImpession
        If VarNbImpession = "" Then Exit Sub

            'Vérifi Qu'il s'agit d'une valeur numerique
            If IsNumeric(VarNbImpession) = False Then
            MsgBox "Valeurs nombre d'impression invalide"
            Exit Sub
            End If

            If VarNbImpession > 10 Then
            MsgBox "nombres de copie > 10"
            Exit Sub

            Else

            Application.ScreenUpdating = False

            'Remplissage des cellules de la page Etiquette (Feuil8) en fontion du N° de ligne selectionner

            Feuil33.Cells(1, 3).Value = Feuil32.Cells(LgImp, 1).Value
            Feuil33.Cells(2, 2).Value = Feuil32.Cells(LgImp, 4).Value
            Feuil33.Cells(3, 3).Value = Feuil32.Cells(LgImp, 16).Value

            'Lance l'impression de la feuil8 suivant zone d'impression prédéfinit en feuil8

 Feuil33.Visible = True
Feuil33.Activate

    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"

ActiveWindow.SelectedSheets.PrintPreview
            'Vider les valeurs des cellules
            Feuil33.Cells(1, 3).Value = ""
            Feuil33.Cells(2, 2).Value = ""
            Feuil33.Cells(3, 3).Value = ""

            MsgBox "Impression réussi"
        Feuil32.Activate

            Application.ScreenUpdating = True
            Exit Sub
             End If

Application.ScreenUpdating = True
End Sub