VBA 代码（从一个 Excel 电子表格复制并粘贴到另一个而不使用公式）

Question

我在下面附上了电子表格的屏幕截图。我对 VBA 代码基本上一无所知，所以我需要一些帮助才能解决问题。

因此，在工作簿 1 的单元格 L15 上，我们计算了工程列的 % DT（停机时间），该列是使用 FILTER 和 SUM 函数计算得出的。

如果我能每周将这个数字拖入工作簿 2 的 C 列，从本周（第 16 周）的单元格 C175 开始，那就太好了。当单元格 D15 中的数字每周刷新时，我希望它将新数字添加到 C 列中（第 17、18 周......）。

到目前为止，我从其他论坛得到了一些帮助，我收到了代码（如下），该代码仅在 B 上的单元格已填充时复制 C 列中的值，并且仅适用于 B 的最后一个值。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("A28:C315")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, x As Long
    Set desWS = Workbooks("Workbook 2.xlsx").Sheets("Update 2023 & 2024 ENG % DT")
    x = desWS.Range("B2:B" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row-1
    desWS.Range("C" & x) = Range("L15").Value
    Application.ScreenUpdating = True
End Sub

感谢您的帮助， 乔尔

我已经尝试过上面的代码，但不知道从那里去哪里

练习册1：

练习册2：

工作簿 1（A28：C315 - 每日报告日志）：

Answer 1

试试这个 - 我不确定我是否完全理解这个计划......

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim destWS As Worksheet, m, wk
    
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("A28:C315")) Is Nothing Then Exit Sub
    
    Set destWS = Workbooks("Workbook 2.xlsx").Worksheets("Update 2023 & 2024 ENG % DT")
    wk = Me.Range("B4").Value
    m = Application.match(wk, destWS.Columns("A"), 0)      'find the week number in ColA
    If Not IsError(m) Then                                 'got a match?
        destWS.Cells(m, "C").Value = Me.Range("L15").Value 'fill the value
    Else
        MsgBox "No week number match for '" & wk & "' !", vbExclamation
    End If
End Sub