keep formatting and borders when copy specific cells from multiple files

[KalilMe]

hi experts
I got this code from this thread Macro to Extract Specific cell data from Multiple Worksbooks into one summary.and mod what I need , but the problem deletes the formatting and borders from summary file .if there is way to keep borders and formatting in file summary when run the macro without delete them . that will treat this problem . any idea,please?

Public Sub Copy_Values_From_Workbooks()

    Dim matchWorkbooks As String
    Dim destSheet As Worksheet, r As Long
    Dim folderPath As String
    Dim wbFileName As String
    Dim fromWorkbook As Workbook
 
    'Folder path and wildcard workbook files to import cells from
 
    matchWorkbooks = "D:\path\*.xlsx"                                             'CHANGE THIS
 
    'Define destination sheet
 
    Set destSheet = ActiveWorkbook.Worksheets("Summary")                                'CHANGE THIS
 
    destSheet.Cells.Clear
    r = 0
 
    Application.ScreenUpdating = False
         
    folderPath = Left(matchWorkbooks, InStrRev(matchWorkbooks, "\"))
    wbFileName = Dir(matchWorkbooks)
    While wbFileName <> vbNullString
        Set fromWorkbook = Workbooks.Open(folderPath & wbFileName)
        With fromWorkbook.Worksheets(1)
            destSheet.Range("B4").Offset(r).Value = .Range("B4").Value
            destSheet.Range("C4").Offset(r).Value = .Range("H4:H5").Value
            destSheet.Range("E4").Offset(r).Value = .Range("H19").Value
           
            r = r + 1
        End With
        fromWorkbook.Close savechanges:=False
        DoEvents
        wbFileName = Dir
    Wend
 
    Application.ScreenUpdating = True
 
    MsgBox "Finished"
 
End Sub

 

[Marc L]

Hi,​

​

use the Range.Copy method rather than just allocating a value …​

 

[KalilMe]

doesn't work . gives error in my case

 

[Marc L]

In order to see where you failed just activate the Macro Recorder and operate manually …​

 

[KalilMe]

I fix it , but not entire solution. I changed this

    destSheet.Cells.Clear

to this

 destSheet.Cells.ClearContents

but it remains one thing . it deletes the headers in row3 . how avoid that? ideas , please?