从多个工作簿指定的工作表中查找指定的数据并输出到一个新的工作表中
Private Sub CommandButton1_Click()
str1 = InputBox("请输入员工编号", "按照员工编号查询数据")
Dim rng As Range
If Len(str1) > 0 Then
a = 3
Set sh = ActiveSheet
Range("a3:y14").ClearContents
Application.ScreenUpdating = False
Set fso = CreateObject("scripting.filesystemobject")
Set ff = fso.getfolder(ThisWorkbook.Path) '
For Each f In ff.Files
If f.Name <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(f)
For j = 1 To wb.Sheets.Count
Set rng = Nothing
Set rng = wb.Sheets(j).Columns(3).Find(str1, lookat:=xlWhole)
If Not rng Is Nothing Then
rng.EntireRow.Copy sh.Cells(a, 1)
a = a + 1
End If
Next j
wb.Close
End If
Next f
Application.ScreenUpdating = True
Else
Exit Sub
End If
End Sub