excel宏有條件地複製另一個工作簿中的特定單元格

Question

我已經花了將近一整天（至少8個小時）試圖找到我的困境的答案，但我的智慧結束了。這裏是場景和問題：

場景： 我們有一個設備工作簿（設備Log.xlsx）。該工作簿有6個工作表（Sheet1，Sheet2，......）。每張工作表在第1行有不同的「標題」，但所有工作表都有幾個共同標題，標題相同（ID，設施，建築，部門，部門和房間）以及每個工作簿中職位不同的人員由於）。

問題： 我需要一個單獨的Excel工作簿（或作爲最後一個工作表，將第7個工作表添加到設備日誌中），打開或一旦用戶點擊特定單元格，然後將通過原始設備日誌文件，查看每個設備的「到期日期」，如果距離「今天（）」的30天內，將複製「ID，設施，建築，部門，部門，房間和到期」活動工作表。

我有一些宏的經驗，但它非常有限。我在大學裏學習了JAVA-101，但我從來沒有繼續這樣做。

我很開明，這個項目。

感謝您花時間閱讀，並感謝+++花時間做出迴應。

Answer 1

我有點無聊，所以我想我會掀起什麼來幫助你：

此代碼看起來在通過每一個工作表中的設備日誌簿和循環，對評價今天的截止日期date ...然後它會將您提到的單元格中的信息複製到您運行此代碼的任何工作簿的下一行中。你可能需要做一些調整，但這應該是一個好的開始。

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