从多个工作簿指定的工作表中查找指定的数据并输出到一个新的工作表中

​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

(0)

相关推荐