使用VBA 将D列选定单元格数据复制到H列的空白单元格，不执行也不报错

tk236990

excel中选择D列任意单元格时，点击控件按钮，复制该单元格内容，检查H列是否有非空单元格，如果有非空单元格，将复制的值粘贴到H列非空单元格中，如果没有非空单元格，提示“H列已满”，但如果选择的是其他非D列单元格，点击控件按钮则弹出提示“请先选择职责”。代码如下（文档见附件）：


Sub CopyToH()
    Dim selectedCell As Range
    Dim cell As Range
    Dim hRange As Range
   
    ' 获取当前选择的单元格
    Set selectedCell = ActiveCell
   
    ' 如果选择的单元格不是D列则提示“请先选择职责”
    If selectedCell.Column <> 4 Then
        MsgBox "请先选择职责", vbExclamation
        Exit Sub
    End If
   
    ' 检查H列是否已满
    Set hRange = Range("H1:H" & ActiveSheet.Cells(Rows.Count, "H").End(xlUp).Row)
    If hRange.Cells.Count = Rows.Count - 1 Then
        MsgBox "H列已满", vbExclamation
        Exit Sub
    End If
   
    ' 找到 H 列第一个空白单元格，将 D 列单元格的内容复制到此单元格
    For Each cell In hRange
        If cell.Value = "" Then
            cell.Value = selectedCell.Value
            Exit Sub
        End If
    Next cell
End Sub

插入控件点击运行，无反应也不报错，请教各位大神，是哪里有问题？

半百

不知道H列到底是咋样的

tk236990

半百 发表于 2023-5-30 18:32
不知道H列到底是咋样的

已上传附件，我增加了一个变量t，“if not t……”但对这句还是语法不对，我试了“if t=false then msgbox……“也还是不行。

cyq4896

不知是不是这样效果

tk236990

cyq4896 发表于 2023-5-30 19:55
不知是不是这样效果

不是，我希望得到的结果是点击一次，将当前在D列所选职责复制粘贴到H2单元格，再点击一次，又将在D列所选职责复制粘贴到H3单元格，再点击一次，又将在D列所选职责复制粘贴到H4单元格，依次类推。您给的答案会一致替换同一个单元格的内容，我是我需要的。

cyq4896

请再试试是吧

tk236990

cyq4896 发表于 2023-5-31 07:17
请再试试是吧

完全正确，学习了，非常感谢