|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub test()
Dim wb As Workbook, wb2 As Workbook, arr, sht As Worksheet
crr = Array("图号", "名称", "需求日期", "数量", "订单日期")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb = ThisWorkbook
td = Date
For Each st In wb.Sheets
st.Activate
arr = st.Range([a1], Cells(Rows.Count, 29).End(xlUp))
ReDim brr(1 To UBound(arr), 1 To 5)
k = 0
For i = 2 To UBound(arr)
If arr(i, 19) >= td Then
k = k + 1
brr(k, 1) = arr(i, 6)
brr(k, 2) = arr(i, 9)
brr(k, 3) = arr(i, 19)
brr(k, 4) = arr(i, 21)
brr(k, 5) = arr(i, 29)
End If
Next
Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\结果.xlsx")
Set sht = wb2.Sheets.Add
sht.Name = st.Name
sht.Cells(1, 1).Resize(1, 5) = crr
sht.Range("a2").Resize(k, UBound(brr, 2)) = brr
Columns("A:E").AutoFit
wb2.Close (True)
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Sheets("表1").Activate
End Sub |
|