VBA formula to need correcting.

[Tofik]

Hi guys, I have a problem. I want tell you some story how it was happen. Nearly 4 month ago I post topic about VBA code to help me gather all info from the same excel files and one guy from this forum create to me VBA code which compilated all same Excels from the folder into one ( I have a very routine paper job ). Everything was good and I was happy, but after some time construction side had a lot of reports and they can't do their job in time. All reports which they creates for me were typed by themselves(manually). But now because of a lot of job they start to use formula to create those reports automatically and it was affected on my VBA code and I don't know how I can fix it. That's why I appeal to you. If someone can fix the VBA code it will be the best news for me today. Reports all rise from hour to hour.

1) I show you Image from Excel with Errors below.
2) I add the Excel as an Example of Report with which I work all day and only number in cells can be different but the structural they are same. In yellow color I mark important places which I need.

Code which I used was this:
Sub Visual_Import()
Dim xWS As Worksheet, xTWB As Workbook, DestSheet As Worksheet, Head As Range
Dim xStrAWBName As String, FolderName As String, sItem As String, Header As Long
Dim FolderPath As String, fldr As FileDialog, Lr As Long, LCD As Long, R As Long
Dim os As Long, LrS As Long, LCS As Long, FileName As String
On Error Resume Next
Set xTWB = ThisWorkbook
Set DestSheet = xTWB.ActiveSheet
  Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    FolderName = sItem
    Set fldr = Nothing
    FolderPath = FolderName & "\"
FileName = Dir(FolderPath & "*.xls*")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open FileName:=FolderPath & FileName, ReadOnly:=True
xStrAWBName = ActiveWorkbook.Name
For Each xWS In ActiveWorkbook.Sheets
If xWS.Name = "10140-CON-PIP-12" Then
Lr = DestSheet.Range("A" & Rows.Count).End(xlUp).Row
LrS = Application.WorksheetFunction.Count(xWS.Range("A11:A26"))
LCS = xWS.Cells(1, Columns.Count).End(xlToLeft).Column + 1
LCD = DestSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
If Lr = 1 Then
Range(xWS.Cells(9, 1), xWS.Cells(10, 35)).Copy DestSheet.Range("B1")
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy Range(DestSheet.Cells(3, 2), DestSheet.Cells(LrS + 2, 36))
DestSheet.Range("A1").Value = "Report Number"
Range(DestSheet.Cells(3, 1), DestSheet.Cells(LrS + 2, 1)).Value = xWS.Range("D7").Value
DestSheet.Cells(1, 37).Value = "Drawing"
Range(DestSheet.Cells(3, 37), DestSheet.Cells(LrS + 2, 37)).Value = Trim(Right(xWS.Range("V4").Value, Len(xWS.Range("V4").Value) - Application.WorksheetFunction.Find("/", xWS.Range("V4").Value)))
Range(xWS.Cells(9, 1), xWS.Cells(10, 35)).Copy
Range(DestSheet.Cells(1, 2), DestSheet.Cells(2, 37)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 1)).Copy
Range(DestSheet.Cells(3, 1), DestSheet.Cells(LrS + 2, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy
Range(DestSheet.Cells(3, 2), DestSheet.Cells(LrS + 2, 37)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(DestSheet.Cells(1, 2), DestSheet.Cells(2, 2)).Copy
Range(DestSheet.Cells(1, 1), DestSheet.Cells(2, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy Range(DestSheet.Cells(Lr + 1, 2), DestSheet.Cells(Lr + LrS, 36))
Range(DestSheet.Cells(Lr + 1, 1), DestSheet.Cells(Lr + LrS, 1)).Value = xWS.Range("D7").Value
Range(DestSheet.Cells(Lr + 1, 37), DestSheet.Cells(Lr + LrS, 37)).Value = Trim(Right(xWS.Range("V4").Value, Len(xWS.Range("V4").Value) - Application.WorksheetFunction.Find("/", xWS.Range("V4").Value)))
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy
Range(DestSheet.Cells(Lr + 1, 2), DestSheet.Cells(Lr + LrS, 37)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 1)).Copy
Range(DestSheet.Cells(Lr + 1, 1), DestSheet.Cells(Lr + LrS, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
End If
Next xWS
Workbooks(xStrAWBName).Close
FileName = Dir()
Loop
DestSheet.Columns("A:AK").WrapText = False
DestSheet.Columns("A:AK").AutoFit
DestSheet.Name = "Consolidate"
xTWB.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub

1) This is the missing info which I have today:
Note( How we can correct the VBA code to take only that info which I saw in Excel Report version and it shouldn't matter was it type manually or use formula.

2)The Example of the Visual Report :

CON-PIP-12-F10210 Example.xlsx

drive.google.com

Thank you guys. It is very important for me and I appreciate your help.