Probleme mise en forme apres copie de classeur pour impression

[PEX]

Bonjour a tous,

cela fait un petit moment que je n'étais pas venu solliciter votre aide.
Je me troune vers vous car j'arrive pas a comprendre comment je peux mettre en place une variable. Je m'explique :
Je copie la feuille d'un classeur vers un nouveau, une mise en forme ce fait mais je dois donner un nombre de ligne de plus lors de l'apercu avant impression il me montre une multitude de page avec simplement le quadrillage et des lignes vides ...

Simplement je voudrais savoir comment dire a la macro, que le nombre de ligne correspond a la derniere ligne avec une valeur dedans ( nom de produits par exemple ) ...

je vous joints mon code et si besoin demandez moi et je joints le fichier mais je devrais tout modifier pour ne pas étre en tort vis a vis de ma société ..

Sub MiseEnFormeTableau()
'Version 1.1 du  24/09

' copy et sauvegarde
Worksheets(1).Copy
ActiveWorkbook.SaveAs "D:\.............\" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xlsx"

' suppression des boutons
 ActiveSheet.Shapes.Range(Array("Image1", "Deconnexionpsw", "Image5", "Image2" _
    , "Image3", "Image4")).Delete
    
' suppression des figeages de volets
ActiveWindow.FreezePanes = False

' suppression des colonnes
Columns("AM:AM").Delete Shift:=xlToLeft
Columns("V:AK").Delete Shift:=xlToLeft
Columns("Q:T").Delete Shift:=xlToLeft
Columns("F:M").Delete Shift:=xlToLeft
Columns("B:B").Delete Shift:=xlToLeft

' mise en largeur des colonnes
    Rows("1:1").RowHeight = 26.25
    Rows("3:31").RowHeight = 15
    Columns("C:C").ColumnWidth = 12.86
    Columns("B:B").ColumnWidth = 16.71
    Columns("D:D").ColumnWidth = 12.14
    Columns("E:E").ColumnWidth = 11.71
    Columns("F:F").ColumnWidth = 10.71
    Columns("G:G").ColumnWidth = 11.29
    Columns("H:H").ColumnWidth = 12.71

' mise en forme du Font
Range("A1:I35").Activate
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Bold = False

' mise en place de tout le quadrillage
    Range("A2:I30").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
' Rajout des lignes pour precision
    
    Range("B1:C1").Merge
    Range("B1:C1").FormulaR1C1 = "Mise A jours le :"
    Range("D1").FormulaR1C1 = Date

    Range("H1").FormulaR1C1 = "Service :"
    Range("I1").FormulaR1C1 = "Production"

' mise en place du logo sur en tete de page avec mise en forme pour impression
    
        ActiveSheet.PageSetup.LeftHeaderPicture.Filename = _
        "D:\.............\logo_2010.png"
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = "&G"
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.236220472440945)
        .RightMargin = Application.InchesToPoints(0.236220472440945)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With

' sauvegarde du fichier
 ActiveWorkbook.save

' aperçu avant impression
 ActiveWindow.SelectedSheets.PrintPreview
   
End Sub

kje suis preneur de toute optimisation ...

Cordialement

Pex