如何用VBA实现在多个sheet中进行模糊查询，并将包含关键字的一整行复制至指定位置？

Sub sousuo() Dim r As Long Dim c As Long Dim str As String Dim rng As Range str = InputBox("输入搜索内容") If Len(str) = 0 Then Exit Sub c = Sheets("Sheet2").Range("A65536").End(xlUp).Row Sheets("汇总").Activate For r = 1 To [A65536].End(xlUp).Row Set rng = Rows(r).Find(str, LookIn:=xlValues, LookAt:=xlPart) If Not rng Is Nothing Then Rows(r).Copy c = c + 1 Worksheets("Sheet2").Range("A" & c).PasteSpecial _ Paste:=xlPasteAll, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End If Next Application.CutCopyMode = FalseEnd Sub

不难实现，但代码就懒得写了。
步骤：
1、利用INPUTBOX（）获得想查询的内容，并存放到局部变量INPUTDATA 中
2、用DIM MYRANGE AS RANGE 和以下语句组合进行查找
Set MyRange = Sheets("工作表名称").Cells.Find(what:=INPUTDATA, After:=ActiveCell, LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
3、用条件语句进行判断是否找到或符合
If MyRange Is Nothing Then
MsgBox "没找到符合条件的记录!"
.....
else
找到的话，进行相应的单元格赋值操作
.....
endif
4、用将上述步骤嵌套到一个循环语句内，以便继续查找。

Sub MySearch()

Dim ws(6) As Worksheet

Dim c1 As Range, c2 As Range

Dim r

    Set ws(1) = Worksheets("Sheet1")    ' 请自行修改为实际的工作表名

    Set ws(2) = Worksheets("Sheet2")    ' 请自行修改为实际的工作表名

    Set ws(3) = Worksheets("Sheet3")    ' 请自行修改为实际的工作表名

    Set ws(4) = Worksheets("Sheet4")    ' 请自行修改为实际的工作表名

    Set ws(5) = Worksheets("Sheet5")    ' 请自行修改为实际的工作表名

    Set ws(6) = Worksheets("Sheet6")    ' 请自行修改为实际的工作表名

    ws(6).Cells.Clear

    Set c2 = ws(6).Range("A1")

    For r = 1 To 1000   ' 由于未说明Sheet5中A列关键字的行数，且其中有空行，请自行修改为实际的行数

        Set c1 = ws(5).Range("A" & r)

        If c1 Like "1*" Then

            ws(3).Cells.Find(c1, lookat:=xlWhole).EntireRow.Copy Destination:=c2

        ElseIf c1 Like "05*" Then

            ws(1).Cells.Find(c1, lookat:=xlWhole).EntireRow.Copy Destination:=c2

        ElseIf c1 Like "0*" Then

            ws(2).Cells.Find(c1, lookat:=xlWhole).EntireRow.Copy Destination:=c2

        ElseIf c1 <> "" Then

            ws(4).Cells.Find(c1, lookat:=xlWhole).EntireRow.Copy Destination:=c2

        End If

        Set c2 = c2.Offset(1, 0)

    Next r

End Sub