从多个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