我有点无聊,所以我想我会拿出一些东西来帮助你:
此代码将查看设备日志工作簿并遍历每个工作表,根据今天的日期评估到期日期......然后它将您提到的单元格中的信息复制到您运行此代码的任何工作簿的下一行。您可能需要进行一些调整,但这应该是一个好的开始。
Sub equipLog()
Dim eqWb As Workbook
Dim sh1 As Worksheet
Dim due, ID, fac, bldg, div, dept, room
Dim dateDue As Date
Dim rArr As Variant
Dim ws As Worksheet
Set sh1 = ThisWorkbook.Sheets("Sheet1")
Set eqWb = Workbooks.Open("C:\Code3\Equipment Log.xlsx") ' change this to your equipment sheet path
wsNums = eqWb.Worksheets.Count
For Each ws In eqWb.Worksheets
ws.Activate
Set due = Cells.Find("Due")
Set ID = Cells.Find("ID")
Set room = Cells.Find("Room")
lrEq = Range("A" & Rows.Count).End(xlUp).Row
For i = (due.Row + 1) To lrEq
dateDue = Cells(i, due.Column)
dd = DateDiff("d", Date, dateDue)
If Abs(dd) < 30 Then
' I'm assuming that the cells are all located in a row in the order you mentioned
rArr = Range(Cells(ID.Row + 1, ID.Column), Cells(room.Row + 1, room.Column))
x = 1
lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
For Each c In rArr
sh1.Cells(lr + 1, x) = c
x = x + 1
Next c
sh1.Cells(lr + 1, x + 1) = dateDue
End If
Next i
Next ws
End Sub