Excel VBA点击按钮将数据粘贴到同日期下三个空闲行的实现求助

你需求的功能可以通过调整原有代码的对象清空逻辑实现，修改后的完整代码如下：

Private Sub CommandButton1_Click()
    Dim Rg As Range
    ' 匹配今日日期对应的首行
    Set Rg = Me.UsedRange.Columns(1).Find(Application.Text(Date, [A16].NumberFormat), [A17], xlValues)
   
    If Rg Is Nothing Then
        MsgBox "Today's Date Not Found. Please check the 'Date Received'"
    Else
        ' 早时段行赋值：当前匹配到的日期行
        Rg(1, 2).Resize(, 24).Value2 = [B16:W16].Value2
        ' 中时段行赋值：日期行下第一行
        Rg(2, 2).Resize(, 24).Value2 = [B16:W16].Value2
        ' 晚时段行赋值：日期行下第二行
        Rg(3, 2).Resize(, 24).Value2 = [B16:W16].Value2
        ' 所有赋值完成后再清空对象
        Set Rg = Nothing
    End If
End Sub

调整说明 #

• 原有注释的赋值逻辑本身符合需求，问题出在第一次赋值后就清空了Rg对象，导致后续两次赋值找不到目标行
• 代码中Rg(1,2)代表匹配到的日期所在行的第2列，Rg(2,2)、Rg(3,2)分别对应后续2行的第2列，正好覆盖早中晚三个时段的行
• 把Rg对象清空操作挪到三次赋值全部完成后执行，即可实现单次点击自动填充三个时段数据的需求

内容的提问来源于stack exchange，提问作者Elias