VBA使用今天的日期选择月列中的最后一个空单元格并粘贴数据

我试图使用VBA脚本在选中复选框时触发，该复选框从一个特定单元格复制数据，并使用今天的日期粘贴到月份列的最后一个空单元格中。这是到目前为止我的代码，我已经测试了触发复制粘贴功能的复选框。我搞不懂的是，使用今天的日期找到正确的列，然后选择该列中的下一个空单元格。我的列在第二张工作表上使用长月份名称文本数据进行标记

Sub CheckBoxUpdated()
Dim Mnth As String
Dim fndrng
Dim cb As CheckBox


Mnth = MonthName(Month(Date))
With Sheet2 'has to be 'with' something to work correctly
    Set fndrng = Cells.Find(What:=Mnth, After:=A1, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=True)
End With

    On Error Resume Next
    Set cb = ActiveSheet.DrawingObjects(Application.Caller)
    On Error GoTo 0

    If Not cb Is Nothing Then
        If cb.Value = 1 Then
            Sheets("Sheet1").Range(cb.LinkedCell).Offset(0, -4).Copy
            Sheets("Sheet2").Activate
            fndrng.Offset(4, 0).Select
            ActiveSheet.Paste
        End If
    End If

End Sub

---

非常感谢您的帮助，谢谢

我立刻注意到两件事

在第一个函数中，设置fndrng=Cells.Find。。。缺少从With语句中分配工作表父级的前缀句点。应设置为fndrng=.Cells.Find

WithSheet2的结尾可以向下扩展，以包含更多的代码，从而使您不再依赖ActiveSheet和Select之类的东西

考虑一下这种重写

Sub CheckBoxUpdated()
    Dim Mnth As String, fndrng as range, cb As CheckBox

    On Error Resume Next

    Mnth = MonthName(Month(Date))

    With Sheet2 'has to be 'with' something to work correctly
        Set fndrng = Cells.Find(What:=Mnth, After:=A1, LookAt:=xlPart, _
                                SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                MatchCase:=True)

        Set cb = .DrawingObjects(Application.Caller)
        On Error GoTo 0

        If Not cb Is Nothing Then
            If cb.Value = 1 Then
                Sheets("Sheet1").Range(cb.LinkedCell).Offset(0, -4).Copy _
                    Destination:=fndrng.Offset(4, 0)
            End If
        End If

    End With

End Sub

我将您的复制粘贴方法更改为更直接的方法，以符合with/End with语句的扩展

---

有关摆脱依靠选择和激活来实现目标的更多方法，请参阅。

这是一个很大的帮助。它确实清理了我的代码。那篇文章内容也很丰富。现在我得到了一个运行时错误91，并且我看到没有设置fndrng，所以当涉及到IF语句时，fndrng的值为零。因此，Find循环没有捕获sheet2第一行中的月份。我一直在想：=A1之后的内容，但无法检查所有内容。之后再试：=.RangeA1好的，这非常有帮助，我遇到了运行时错误，但它最终是一个锁定的单元格，给我带来了问题。现在我需要弄清楚如何在fndrng列中找到第一个空白单元格并将其粘贴到那里。如果正确找到了fndrng，那么fndrng.column就是该列。第一个空白单元格应为.cells1，fndrng.column.endxlDown.offset1，0。