VBA to move cell values to a cell address in each row of a table

Hi,

I have a list on sheet "New Template" of values in range L9:L32 (New Date) with cell addresses (eg, $D$14) in the next column range M9:M32 (Cell Ref) that I need the values coping to on a sheet called "Dates".

I want to write a macro that loops through the list and moves the each date, then clears data in "New Template".

I have tried this but it doesn't work at all:

Sub Test1()
Dim lRow As Integer
Dim i As Integer

lRow = Cells(Rows.Count, 9).End(xlUp).Row

For i = 9 To lRow

If (Cells(i, 12) = "") Then

Else

Cells(i, 12).Copy
CellAdd = Cells(i, 13).Value
Sheets("Dates").Range.CellAdd.PasteSpecial Paste:=xlPasteValues

End If
Next i

On Error GoTo 0

End Sub

Any help would be appreciated, even if it is to be told its not possible!!

Thanks. The cause of the problem was that there are other data below the update table.

This version should work:

Sub MoveDates()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim s As Long
    Dim m As Long
    Application.ScreenUpdating = False
    Set ws = Worksheets("New Template")
    Set wt = Worksheets("Dates")
    m = ws.Range("L31").End(xlUp).Row
    For s = 9 To m
        wt.Range(ws.Range("M" & s).Value).Value = ws.Range("L" & s).Value
    Next s
    ws.Range("L9:L" & m).ClearContents
    Application.ScreenUpdating = True
End Sub

11 Replies

HansVogelaar

MVP

Sep 13, 2022

Lindsy

A slightly different version:

Sub MoveDates()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim s As Long
    Dim m As Long
    Application.ScreenUpdating = False
    Set ws = Worksheets("New Template")
    Set wt = Worksheets("Dates")
    m = ws.Range("L" & ws.Rows.Count).End(xlUp).Row
    For s = 9 To m
        If ws.Range("L" & s).Value <> "" Then
            wt.Range(ws.Range("M" & s).Value).Value = ws.Range("L" & s).Value
        End If
    Next s
    ws.Range("L9:L" & m).ClearContents
    Application.ScreenUpdating = True
End Sub

Lindsy
Copper Contributor
Sep 13, 2022
HansVogelaar
Thank you so much, I ran this and got a Type 13 mismatch :
If ws.Range("L" & s).Value <> "" Then
- HansVogelaar
  MVP
  Sep 13, 2022
  Lindsy
  
  Does column L contain error values?

HansVogelaar
MVP
Sep 13, 2022
Lindsy

Change

Sheets("Dates").Range.CellAdd.PasteSpecial Paste:=xlPasteValues

to

Sheets("Dates").Range(CellAdd).PasteSpecial Paste:=xlPasteValues
- Lindsy
  Copper Contributor
  Sep 13, 2022
  Thank you, just saw your reworked version 🙂

Forum Discussion

VBA to move cell values to a cell address in each row of a table

11 Replies

Resources