很简单。

Sub ss()
s1 = CStr(Cells(2, "L"))
n = [a65535].End(xlUp).Row
[L3:AA65535].ClearContents
k = 3
For i = 2 To n
If Cells(i, "A") <> "" And Cells(i - 1, "A") = "" Then
s2 = CStr(Cells(i, "A"))
If InStr(s2, s1) <> 0 Then
For j = i To n
If Cells(j, "A") = "" Then
k = k + 1
Exit For
End If
Range(Cells(j, "A"), Cells(j, "E")).Copy Cells(k, "L")
k = k + 1
Next j
End If
End If
Next i
End Sub

简单。