Macro to open multiple files and extracts data from them |VBA & Macros|Excel Forum|My Online Training Hub

Hi to all of you, I  am working in a project in VBA and I am trying to add some information to the following code and I am a little confuse, maybe someone can help:

1. I would like to add a column (in column A) calls "Laboratory" that extracts the information of cell P2 of the "report stampabile"

2. To add a column (in column B) calls "Evaluation Date" that extracts the infomation of cell I3 from "report stampabile"

3. To add a column (in column C) calls "Technical Functionary" that extract the informationof cell E18 from "Rilievo 1"

4. To add a column (in column F) calls "Inspector 2" that extract the information of d14,d24,d34 etc from "report stampabile"

files attached are the ones that have to be used to be opened and extract the data

This is the code I have: 

1. Sub Consolidate_Data()
2. Application.ScreenUpdating = False
3. Dim wb As Workbook, sh As Worksheet, dsh As Worksheet, File_Name As Variant, i As Long, lr As Long, x As Long
4. Dim desWS As Worksheet, srcWS As Worksheet, r As Long: r = 6
5. Set dsh = ThisWorkbook.Sheets("Sheet1")
6. dsh.UsedRange.ClearContents
7. File_Name = Application.GetOpenFilename("Excel Files (*.xl*),*.xl*", , "Select Excel Files To Consolidate", , True)
8. For i = LBound(File_Name) To UBound(File_Name)
9. Set wb = Workbooks.Open(File_Name(i))
10. If Not Evaluate("isref('" & "ExtractedData" & "'!A1)") Then
11. Sheets.Add before:=Sheets(1)
12. ActiveSheet.Name = "ExtractedData"
13. Range("A1").Resize(, 5) = Array("Classification", "Inspector", "Standard", "Requirement", "Classification Rilievi")
14. Columns.AutoFit
15. Else
16. Sheets("ExtractedData").UsedRange.Offset(1).ClearContents
17. End If
18. Set desWS = Sheets("ExtractedData")
19. Set srcWS = Sheets("report stampabile")
20. lr = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
21. For x = 5 To lr Step 10
22. Select Case srcWS.Range("P" & x).Value
23. Case "NC", "OSS", "COM"
24. With desWS
25. .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Array(srcWS.Range("P" & x), srcWS.Range("P" & x).Offset(6, -12), srcWS.Range("P" & x).Offset(1, -13), srcWS.Range("P" & x).Offset(1, -9))
26. With Sheets(r)
27. Select Case .Range("P5").Value
28. Case "OSS", "NC", "COM"
29. desWS.Cells(desWS.Rows.Count, "E").End(xlUp).Offset(1) = Sheets(r).Range("P5")
30. r = r + 1
31. If desWS.Cells(desWS.Rows.Count, "E").End(xlUp) = 0 Then
32. desWS.Cells(desWS.Rows.Count, "E").End(xlUp) = ""
33. End If
34. End Select
35. End With
36. End With
37. End Select
38. Next x
39. With desWS
40. .Columns.AutoFit
41. .UsedRange.Copy dsh.Cells(dsh.Rows.Count, "A").End(xlUp).Offset(1)
42. End With
43. wb.Close False
44. r = 6
45. Next i
46. With dsh
47. .Rows(1).Delete
48. .Columns.AutoFit
49. End With
50. Application.ScreenUpdating = True
51. End Sub