将单元格值复制到一系列单元格

时间:2016-09-28 21:54:58

标签: excel vba excel-vba range cell

我是VBA的新手,我正在尝试在值变化时将值从一个单元格复制到多个单元格。

A2的值不断变化,当发生这种情况时,我希望将该值复制到单元格C2:C21(然后最终复制到单元格D2:D21)

以下是我想要实现的一个例子:

http://i.stack.imgur.com/xJZyZ.jpg

到目前为止,我写了这段代码:

Sub Worksheet_Change(ByVal Target As Range)
   For i = 0 To 19
      If Not Intersect(Target, Range("AS2")) Is Nothing Then
         Cells(Target.Row + i, 58).Value = Cells(Target.Row, 45).Value
      End If
   Next i
End Sub

但这仅将A2的单个值复制到所有单元格C2到C22。

愿任何人帮我正确编写此代码吗?

2 个答案:

答案 0 :(得分:1)

Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("AS2")) Is Nothing Then
        For CurCol = 3 to 4
            For CurRow = 2 to 21
                If Cells(CurRow, CurCol).Value = "" Then
                    Cells(CurRow, CurCol).Value = Target.Value
                    Exit Sub
                EndIf
            Next CurRow
        Next CurCol
    End If
End Sub

答案 1 :(得分:0)

我想这就是你所追求的:

Option Explicit

Sub Worksheet_Change(ByVal Target As Range)
    Dim nVals As Long

    If Not Intersect(Target, Range("A2")) Is Nothing Then
        With Range("C2:D21")
            nVals = WorksheetFunction.CountA(.Cells)
            If nVals = .Count Then Exit Sub
            Application.EnableEvents = False
            On Error GoTo exitsub
            .Cells(nVals Mod .Rows.Count + 1, IIf(nVals >= .Rows.Count, 2, 1)).Value = Target.Value
        End With
    End If

exitsub:
Application.EnableEvents = True
End Sub