从多个sheet里提取指定数据到某一sheet

Sub lqxs()
Dim Arr, i&, Sht As Worksheet, n&
n = 1
For Each Sht In Sheets
If Sht.Name <> "汇总" Then
Arr = Sht.[b2:e2]
n = n + 1
Cells(n, 1) = Sht.Name
Cells(n, 2).Resize(1, 4) = Arr
End If
Next
End Sub