CODEWITHSUNDEEP
vbaexcelrangecell
Nanogorn
Nanogorn

Reputation: 9

Copy cell value to a range of cells

I'm new to VBA and I am trying to copy values from one cell to multiple cells when its value changes.

The value of A2 is constantly changing and when that happens I want that value to be copied to cells C2:C21 (and then eventually to cells D2:D21)

Here is an example of what I would like to achieve:

https://i.sstatic.net/xJZyZ.jpg

So far I wrote this code:

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

but this only copies one single value of A2 to all the cells C2 to C22.

May anyone help me write this code properly?

Upvotes: 0

Views: 179

Answers (2)

user3598756
user3598756

Reputation: 29421

I guess this is what you're after:

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

Upvotes: 0

Chrismas007
Chrismas007

Reputation: 6105

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

Upvotes: 1

Related Questions