VBA Help - Copy/Paste Not Bringing over Formats????

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
614
Office Version
2016
Platform
MacOS
Hi guys, have an issue that is giving me a headache.

I have 25 .xls files (formatted for 97-2003 Worksheet). All the files are the same and have the same data in them. The only difference of the files is a few Headers of Territory names (i.e contry names).

I have a macro on a seperate .xlsm file that inserts two new sheets with some data and some formatted Borders. The issue I am having is that about 20 of the .xls files copy over the new sheets without any issues, but I have 5 that copy over the details just fine but the borders are all missing?

Any help on this is appreciated.

My code below
Code:
Public Sub CopySheet()


    Dim SourceSheet As Worksheet, SourceSheet2 As Worksheet
    Dim folder As String, filename As String, vFilename As String, vFileWKBK, vFilepath As String
    Dim vCell As Range
    Dim DestBook As Workbook
        
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
        
    'Worksheet in active workbook to be copied as a new sheet to the 160 workbooks
    Set SourceSheet = ThisWorkbook.Worksheets("R&O")
    Set SourceSheet2 = ThisWorkbook.Worksheets("Executive Summary")
        
    For Each vCell In Range("LISTTERRITORYNAME").Cells
            vFilepath = ThisWorkbook.Path & "\"     'Uses the files folder location for directory
            vFileWKBK = Range("TBTPREFIX").Value & " - " & vCell.Value & ".xls*"
            vFilename = vFilepath & vFileWKBK
    
        Application.AskToUpdateLinks = False 'Supresses External links warning
        
    If Dir(vFilename) <> "" Then
   Set DestBook = Workbooks.Open(vFilename)
                  
    SourceSheet.Cells.Copy
        On Error Resume Next
                Worksheets.Add(After:=Worksheets("Tables")).Name = "R&O"
       
    With DestBook.Sheets("R&O").Range("A1")
       .PasteSpecial
          ActiveWindow.DisplayGridlines = False
               Application.CutCopyMode = False
         End With
         
         '-------Print Setup---------
    With DestBook.Sheets("R&O").PageSetup
        .Zoom = False
        .PrintArea = "$A$1:$L$30"
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintGridlines = False
        .Orientation = xlLandscape
    End With
                
              
     SourceSheet2.Cells.Copy
        Worksheets.Add(After:=Worksheets("Tables")).Name = "Executive Summary"
       
    With DestBook.Sheets("Executive Summary").Range("A1")
       .PasteSpecial
            .Tab.Color = 255
                ActiveWindow.DisplayGridlines = False
                Application.CutCopyMode = False
              End With
              
              '-------Print Setup---------
    With DestBook.Sheets("Executive Summary").PageSetup
        .Zoom = False
        .PrintArea = "$A$1:$H$62"
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintGridlines = False
        .Orientation = xlLandscape
         End With
    
              
    With DestBook
        Sheets("R&O").Tab.Color = 255
        Sheets("Executive Summary").Tab.Color = 255
    End With
    
    On Error GoTo 0
                                            
     DestBook.Close True
     
             Else
     
     'MsgBox vFileWKBK & " Not Found"
     
            End If
     
    Next vCell
    
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With


End Sub
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
11,781
Office Version
365, 2010
Platform
Windows, Mobile
Any conditional formatting on the 5 sheets?
 

Forum statistics

Threads
1,086,246
Messages
5,388,674
Members
402,134
Latest member
McKnze21

Some videos you may like

This Week's Hot Topics

Top