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

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
693
Office Version
  1. 2016
Platform
  1. 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
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Any conditional formatting on the 5 sheets?
 
Upvote 0

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top