VBA exports worksheet from XLSM to XLXS matching all source properties doesn't keep print area

[brentcole]

I use this macro in lots of our workbooks with macros to export single worksheets. It grabs all the source pagesetup settings, margins, etc. with the exception of the vertical page break. When I open the exported file, the vertical page break needs to be moved over right one column.
I've even tried moving the pagebreak with "ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1" but it bombs out the macro.

Is there a setting I am missing?

Sub ExportSheetAsXLSX()

    Dim ws As Worksheet
    Dim newWorkbook As Workbook
    Dim exportPath As String
    Dim FileName As String
    Dim currentDate As String
    Dim fullPath As String
    Dim response As VbMsgBoxResult
    
    '''''adding these get current issue into export xlxs file name
    Dim wbBook As Workbook
    
    Dim wsSource As Worksheet
    Dim IssueType As String
    Dim cName As String
    Dim pNum As String
    Dim pTitle As String

    'Initialize the Excel objects and delete any artifacts from the last time the macro was run.
    Set wbBook = ThisWorkbook
    With wbBook
        Set wsSource = .Worksheets("Project_Data")
        On Error Resume Next
        .Names("Source").Delete
        On Error GoTo 0
    End With
    
    On Error GoTo CleanExit                         'make sure enableevents is set back to true on
    Application.EnableEvents = False                'make sure pivot table data is only updated once
    '''''adding these get current issue into export xlxs file name
    
    ' Set the worksheet to export
    Set ws = ThisWorkbook.Sheets("Line List_Prj")
    
    ' Define the export path (customize as needed)
    exportPath = ThisWorkbook.Path & "\"

    ' Get the current date formatted as YYYYMMDD
    currentDate = Format(Date, "mm-dd-yy")
    
    'get current issue type from Project_Data sheet to use in file name
    IssueType = wsSource.Range("B2").Value
    cName = wsSource.Range("D2").Value
    pNum = wsSource.Range("D4").Value
    pTitle = wsSource.Range("D3").Value
    
       
    ' Create the filename
    'example: Consolidated_BOM_For Review & Comment_LACC_ LLC _AXIALL_LOTTE JOINT VENTURE__CLIENT PRJ Lb_CLIENT PROJECT TITLE_10-10-24
    FileName = "PrjLineList_" & pNum & "_" & IssueType & "_" & cName & pTitle & "_" & currentDate & ".xlsx"
    
    'remove and replace illegal file name characters
    FileName = Replace(FileName, "~", "_")
    FileName = Replace(FileName, "!", "_")
    FileName = Replace(FileName, "@", "at")
    FileName = Replace(FileName, "#", "Lb")
    FileName = Replace(FileName, "$", "Money")
    FileName = Replace(FileName, "^", "_")
    FileName = Replace(FileName, "*", "_")
    FileName = Replace(FileName, "(", "_")
    FileName = Replace(FileName, ")", "_")
    FileName = Replace(FileName, "=", "-")
    FileName = Replace(FileName, "+", "_")
    FileName = Replace(FileName, "[", "_")
    FileName = Replace(FileName, "]", "_")
    FileName = Replace(FileName, "{", "_")
    FileName = Replace(FileName, "}", "_")
    FileName = Replace(FileName, ";", "_")
    FileName = Replace(FileName, ":", "-")
    FileName = Replace(FileName, "'", "_")
    FileName = Replace(FileName, """", "in")
    FileName = Replace(FileName, ",", "_")
    FileName = Replace(FileName, "/", "_")
    FileName = Replace(FileName, "?", "_")
    FileName = Replace(FileName, "<", "_")
    FileName = Replace(FileName, ">", "_")
    FileName = Replace(FileName, "\", "_")
    FileName = Replace(FileName, "|", "_")
    
    fullPath = exportPath & FileName

    ' Check if the file already exists
    If Dir(fullPath) <> "" Then
        response = MsgBox("The file '" & FileName & "' already exists. Do you want to overwrite it?", vbYesNo + vbExclamation, "File Exists")
        If response = vbNo Then Exit Sub
    End If

    ' Create a new workbook
    Set newWorkbook = Workbooks.Add

    ' Copy the range from columns A to AH from Line List_Prj to the new workbook
    ws.Range("A:AH").Copy
        With newWorkbook.Sheets(1).Range("A1")
            .PasteSpecial Paste:=xlPasteValues   ' Paste values only
            .PasteSpecial Paste:=xlPasteFormats  ' Paste formats
        End With
        
    'need to copy the picture also - have to switch back to Line List_Prj worksheet first
    ws.Activate
    ws.Shapes.Range(Array("Picture 2")).Select
    Selection.Copy
        With newWorkbook.Sheets(1).Range("A1")
            .PasteSpecial Paste:=xlPasteValues   ' Paste values only
            .PasteSpecial Paste:=xlPasteFormats  ' Paste formats
        End With
        
    'Need to set filename formula and paste in new sheet
    ws.Activate
    ws.Range("AH3").Copy
        With newWorkbook.Sheets(1).Range("AH3")
            .PasteSpecial Paste:=xlPasteFormulas   ' Paste formula
        End With
    
    ' Set the worksheet tab name to the current date
    newWorkbook.Sheets(1).Name = currentDate

    ' Copy headers and footers from the original worksheet
    With ws.PageSetup
        With newWorkbook.Sheets(1).PageSetup
            .CenterHeader = ws.PageSetup.CenterHeader
            .LeftHeader = ws.PageSetup.LeftHeader
            .RightHeader = ws.PageSetup.RightHeader
            .CenterFooter = ws.PageSetup.CenterFooter
            .LeftFooter = ws.PageSetup.LeftFooter
            .RightFooter = ws.PageSetup.RightFooter
            
            'Copy paper size
            .PaperSize = ws.PageSetup.PaperSize
            .Zoom = ws.PageSetup.Zoom
            .PrintQuality = ws.PageSetup.PrintQuality
            .CenterHorizontally = ws.PageSetup.CenterHorizontally
            .CenterVertically = ws.PageSetup.CenterVertically
            .Orientation = ws.PageSetup.Orientation
            
            ' Copy margin settings
            .TopMargin = ws.PageSetup.TopMargin
            .BottomMargin = ws.PageSetup.BottomMargin
            .LeftMargin = ws.PageSetup.LeftMargin
            .RightMargin = ws.PageSetup.RightMargin
            
            ' Set other margin properties
            .HeaderMargin = ws.PageSetup.HeaderMargin
            .FooterMargin = ws.PageSetup.FooterMargin
            
            ' Copy scaling settings
            .Zoom = ws.PageSetup.Zoom
            .FitToPagesWide = ws.PageSetup.FitToPagesWide
            .FitToPagesTall = ws.PageSetup.FitToPagesTall
            '''.FitToHeight = ws.PageSetup.FitToHeight
            '''.FitToWidth = ws.PageSetup.FitToWidth
            
            ' Copy rows to repeat
            .PrintTitleRows = ws.PageSetup.PrintTitleRows
            '''.RowsToRepeatAtTop = ws.PageSetup.RowsToRepeatAtTop
            '''On Error Resume Next
            '''.RowsToRepeatAtTop = .RowsToRepeatAtTop
            '''On Error GoTo 0
            
            ' Copy print area
            .printArea = ws.PageSetup.printArea
            .FitToPagesWide = ws.PageSetup.FitToPagesWide
            .FitToPagesTall = ws.PageSetup.FitToPagesTall
        End With
        
    End With
    
    ' Set the row height to match the original
    newWorkbook.Sheets(1).Rows(1).RowHeight = ws.Rows(1).RowHeight
    newWorkbook.Sheets(1).Rows(2).RowHeight = ws.Rows(2).RowHeight
    newWorkbook.Sheets(1).Rows(3).RowHeight = ws.Rows(3).RowHeight
    
    ' Save the new workbook
    newWorkbook.SaveAs FileName:=fullPath, FileFormat:=xlOpenXMLWorkbook
    newWorkbook.Close SaveChanges:=False

    ' Inform the user
    MsgBox "Export completed! The file is saved as: " & FileName, vbInformation, "Export Successful"

CleanExit:
    ActiveWorkbook.Save
    Application.EnableEvents = True
    Application.Cursor = xlDefault
    'if screenupdating was enabled when readjobinfo started, reenable it
    If Application.ScreenUpdating = True Then Application.ScreenUpdating = True
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True
    On Error GoTo 0            'return to standard error handling
    
End Sub