如何将不同工作表中的指定行的内容合并到一个工作表中？

查询？

Option Explicit
Sub copy_values() 'Copy数据
Dim wks As Worksheet
Dim i As Integer
If wks_exists("语文合并") Then
Set wks = Worksheets("语文合并")
wks.Cells.Clear
Else
Set wks = Worksheets.Add(after:=Worksheets(Worksheets.Count))
wks.Name = "语文合并"
End If
Dim rg As Range
For i = 1 To Worksheets.Count
Set rg = wks.Cells(wks.Rows.Count, 1).End(3).Offset(1)
With Worksheets(i)
If .Name <> "语文合并" Then
rg.Resize(5, 7).Offset(0, 1).Value = .Range("B4:H8").Value
rg.Resize(5, 1).Value = .Name
End If
End With
Next
End Sub
Function wks_exists(ByVal wks_name As String) As Boolean '检测工作表是否存在
Dim wks As Worksheet
wks_exists = False
For Each wks In Worksheets
If wks.Name = wks_name Then
wks_exists = True
Exit Function
End If
Next
End Function
Sub test() '测试
insert_sheet 20
reset_sheet_name "班x"
End Sub
Sub insert_sheet(ByVal cnt As Integer)
Sheets.Add after:=Sheets(Sheets.Count), Count:=cnt
End Sub
Sub reset_sheet_name(ByVal shName As String)
Dim wks As Worksheet, cnt As Integer
For Each wks In Worksheets
cnt = cnt + 1
wks.Name = cnt & shName
Next
End Sub