VBA综练三

rmsc_kr

指定目录的汇总文件


Sub 汇总()
Dim x%
Dim stpath$, stname$, st$
Dim bk As Workbook
Range("a4:i30").ClearContents
stpath = ThisWorkbook.Path & "/data/"
stname = Dir(stpath & "*.xls?")
Do While stname <> ""
x = Range("A65535").End(3).Offset(1).Row
st = Split(stname, ".")(0)
If Application.WorksheetFunction.CountIf(Range("b4:b30"), st) = 0 Then
   Set bk = Workbooks.Open(stpath & stname)
   ThisWorkbook.Activate
   Range("g2") = Year(Now)
   Range("i2") = Format(Now(), "yyyy/m/d")
       With bk.Sheets(1)
       Cells(x, 1) = x - 3
       Cells(x, 2) = Split(stname, ".")(0)
       Cells(x, 3) = .Range("c2")
       Cells(x, 4) = .Range("c3")
       Cells(x, 5) = .Range("f5")
       Cells(x, 6) = .Range("c5")
       Cells(x, 7) = .Range("c6")
       Cells(x, 8) = .Range("f6")
       End With
   bk.Close
   End If
stname = Dir
Loop
End Sub