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?
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?
Code:
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