' Check public Function check () as Variant on Error GoTo erlb dim strdir as String st Rdir = Thisworkbook.worksheets ("Path"). Range ("B2") objfile = Dir (Strdir & "\*.xlsx") thisworkbook.worksheets ("Result"). Activate with ActiveSheet . Range ("a2:b400"). Select '. Cells.select selection.clearcontents . Range ("A1"). Select end with application.screenupdating = False do while objfile <> "" &nb sp; workbooks.open strdir & "\" & objfile ' Workbooks (objfile). Activate activeworkbook.worksheets ("Sheet1"). Activate maxrow = ActiveSheet.UsedRange.Rows ( ActiveSheet.UsedRange.Rows.Count). Row
icnt = 0 startrow = 9 with ActiveSheet for iRow = StartRow to MaxRow If Trim (ActiveSheet.Cells (IRow, 1)) <> "then If Trim (ActiveSheet.Cells (IRow, 2)) = "" Then icnt = icnt + 1 End If Else Exit for End If Next End with Workbooks (objfile). Activate ' Workbooks (objfile). Close activeworkbook.close with thisworkbook.worksheets ("results") Resultmaxrow =. Usedrange.rows (. UsedRange.Rows.Count). Row . Cells (Resultmaxrow + 1, 1) = objFILE . Cells (Resultmaxrow + 1, 2) = icnt End with obj File = Dir Loop application.screenupdating = True MsgBox "Finished" exit Function ERLB:
MsgBox Err.Number & Err.Description End Function
How to open an Excel file under a folder by using VBA code in turn