Data from multiple workbook into single workbook

Try this:

Sub XTract(): Dim r As Long, wa As Worksheet
Set wa = ActiveSheet: r = 2
Do Until Range("A" & r) = ""
'If Range "A" is the filename
Workbooks.Open Range("A" & r), UpdateLinks:=0
wa.Range("B" & r) = Range("B2")
ActiveWorkbook.Close False
r = r + 1: Loop
End Sub