EXCEL VBA复制单元格

Question

我想用VBA实现：在A10:A100的单元格内添加1个内容，就把它复制到对应的D列去。A列如果是空的，那么就不要复制，我要手动在D列输入数据。

下面是高手给的代码：
Private Sub Worksheet_Change(ByVal Target As Range)If Target.Column = 1 And Target <> "" And Target.Row >= 10 And Target.Row <= 100 Then Target.Offset(0, 3) = Target.ValueEnd Sub

但是我发现这段代码有如下问题：
单元格下拉填充超过1个单元格，就会报错提示类型不匹配13；
删除已填充的数据大于1个单元格时，会有同样错误提示。

请指教

Answer 1

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A10:A100]) Is Nothing Then Exit Sub '判断选定单元格是否与A10:A100重合
    
    Set Target = Intersect(Target, [a10:a100]) '直接将选定单元格修改为重合部分
    
    Application.EnableEvents = False '禁止EXCEL响应事件，防止代码嵌套运行
    Dim myCell As Range
    For Each myCell In Target.Cells '遍历每个选定单元格
        '若不为空则复制到D列
        If myCell.Value <> "" Then myCell.Offset(0, 3).Value = myCell.Value
    Next
    Application.EnableEvents = True '恢复响应事件
End Sub

Answer 2

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim myCell As Range
For Each myCell In Target.Cells
With myCell
If .Column = 1 And .Value <> "" And .Row >= 10 And .Row <= 100 Then
.Offset(0, 3).Value = .Value
End If
End With
Next
Application.EnableEvents = True
End Sub

追问

你好，感谢指教
我测试了OK
但是A10-A100内的数据，当下拉填充超过2行，或者删除超过2行时，就会报错：类型不匹配13
这个该怎么解决呢

追答

我测试的结果是正常的，并未发现你所说的报错的问题，可能是你系统设置的事。
要不在最开始你加上一句
on error resume next
这样可以忽略所有错误

Answer 3

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False
    if target.count=1 then
    Dim myCell As Range
    For Each myCell In Target.Cells
        With myCell
            If .Column = 1 And .Value <> "" And .Row >= 10 And .Row <= 100 Then
                .Offset(0, 3).Value = .Value
            End If
        End With
    Next
    end if
    Application.EnableEvents = True
End Sub

加一个判断就应该OK

Answer 4

Excel怎么复制单元格？这个视频告诉你！