Doing so can save memory.
Sub fileopen()
Dim pth As String, i As Integer, setting_Sh As Worksheet, data_Sh As Worksheet
Dim arr, d As Object, Fruit$
Set d = CreateObject("scripting.dictionary")
Set data_Sh = ThisWorkbook.Sheets("Data")
With data_Sh
arr = .[a1].CurrentRegion
For i = 2 To UBound(arr)
If Not d.exists(arr(i, 1)) Then
d(arr(i, 1)) = "a1:b1," & Cells(i, 1).Resize(, 2).Address(0, 0)
Else
d(arr(i, 1)) = d(arr(i, 1)) & "," & Cells(i, 1).Resize(, 2).Address(0, 0)
End If
Next i
End With
Application.ScreenUpdating = False
Set setting_Sh = ThisWorkbook.Sheets("Setting")
With setting_Sh
pth = .Range("H6").Value
For i = 1 To .Cells(Rows.Count, 1).End(3).Row
Fruit = .Cells(i, 1).Value
Workbooks.Open pth & "/" & Fruit & ".xlsx"
data_Sh.Range(d(Fruit)).Copy ActiveWorkbook.Sheets(1).[a1]
ActiveWorkbook.Close True
Next i
End With
Application.ScreenUpdating = True
End Sub