Estrazione dati da più file excel uguali

Sub Openfile()
Set xlApp = New Excel.Application
Dim strFile As String
Set sh = ThisWorkbook.Sheets(1)
mFolder = "F:\Download\E\" ' <<<<<<<< da modificare
strFile = Dir(mFolder & "*.xlsx")
riga = 2
Do While strFile <> ""
    Set WB = xlApp.Workbooks.Open(mFolder & strFile)
    sh.Cells(riga, 1).Value = WB.Sheets(1).Range("B2").Value
    sh.Cells(riga, 2).Value = WB.Sheets(1).Range("B6").Value
    sh.Cells(riga, 3).Value = WB.Sheets(1).Range("B8").Value
    sh.Cells(riga, 4).Value = WB.Sheets(1).Range("B10").Value
    WB.Close False
    riga = riga + 1
    strFile = Dir
Loop
xlApp.Quit
Set WB = Nothing
Set xlApp = Nothing
End Sub

Sub Openfile()
Set xlApp = New Excel.Application
Dim strFile As String
Set sh = ThisWorkbook.Sheets(1)
mFolder = "F:\Download\E\" ' <<<<<<<< da modificare
strFile = Dir(mFolder & "*.xlsx")
riga = 2
Do While strFile <> ""
  Set WB = xlApp.Workbooks.Open(mFolder & strFile)
  for col = 6 to 30
    sh.Cells(riga, col - 5).Value = WB.Sheets(1).Range("B" & col).Value
  next
  WB.Close False
  riga = riga + 1
  strFile = Dir
Loop
xlApp.Quit
Set WB = Nothing
Set xlApp = Nothing
End Sub

Sub accoda()
Set xlApp = New Excel.Application
Dim strFile As String
Set sh = ThisWorkbook.Sheets(1)
mFolder = "F:\Download\a\" ' <<<<<<<< da modificare
strFile = Dir(mFolder & "*.xlsx")
riga = 2
Do While strFile <> ""
  Set WB = xlApp.Workbooks.Open(mFolder & strFile)
  r = WB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
  WB.Sheets(1).Range("A2:C" & r).Copy
  sh.Range("A" & riga).PasteSpecial xlPasteFormats
  WB.Close False
  riga = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
  strFile = Dir
Loop
xlApp.Quit
Set WB = Nothing
Set xlApp = Nothing
End Sub