Help with Copy & Paste Loop Cell by Cell

BRE3

New Member
Joined
Apr 17, 2020
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Hello,

I've been working on this macro and can't seem to get it to work.

What I need it to do is this:
1. Start by Copying Cell A2 in Worksheet "CP Report Pull"
1587155240494.png

2. Then paste the copied A2 in to cell K2 (Circled in Green) on Worksheet "Week View" (Also Circled in Green)
3. After pasting in to K2, copy cell K14 (Circled in Red)
1587155479489.png

4. Paste the copied K14 value in to cell A2 (Circled in Green) on Worksheet "Sheet2"(Also Circled in Green)
1587155800875.png

*5. I need this Macro to be able to repeat itself. For example, after it is done doing A2, it will repeat the above process for A3 in Worksheet "CP Report Pull" and know to paste in cell A3 on Worksheet "Sheet2" and so on.*

As of right now this is the macro that executes the initial action for cell A2.
1587156269138.png


Can somebody help me?
 

Attachments

  • 1587155188681.png
    1587155188681.png
    153.4 KB · Views: 3

Some videos you may like

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

rpaulson

Well-known Member
Joined
Oct 4, 2007
Messages
1,116
try this:
VBA Code:
Sub Do_it()

Dim rs1, rs2, rs3 As Worksheet
Set rs1 = Worksheets("CP Report Pull")
Set rs2 = Worksheets("Week View")
Set rs3 = Worksheets("Sheet2")


For r = 2 To rs1.Range("A" & Rows.Count).End(xlUp).Row

rs2.[K2] = rs1.Cells(r, "A").Value
rs3.Cells(r, "A") = rs2.[K14].Value

Next r

MsgBox "Done"

End Sub

hth,
-Ross
 

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,137
Office Version
  1. 365
Platform
  1. Windows
See if this works:

VBA Code:
With Sheets("CP Report Pull")
    lr = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 2 To lr
        Sheets("Week View").Range("K2").Value = .Range("A" & i).Value
        Sheets("Sheet2").Range("A" & i).Value = Sheets("Week View").Range("K14").Value
    Next
End With
 

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,137
Office Version
  1. 365
Platform
  1. Windows
You should also maybe clear column A on Sheet2 at the start of the macro if required
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

How about

VBA Code:
Sub LoopCells()
  Dim c As Range
  For Each c In Sheets("CP Report Pull").Range("A2", Sheets("CP Report Pull").Range("A" & Rows.Count).End(3))
    Sheets("Week View").Range("K2").Value = c.Value
    Sheets("Sheet2").Range("A" & Rows.Count).End(3)(2).Value = Sheets("Week View").Range("K14").Value
  Next
End Sub
 

BRE3

New Member
Joined
Apr 17, 2020
Messages
4
Office Version
  1. 365
Platform
  1. Windows
try this:
VBA Code:
Sub Do_it()

Dim rs1, rs2, rs3 As Worksheet
Set rs1 = Worksheets("CP Report Pull")
Set rs2 = Worksheets("Week View")
Set rs3 = Worksheets("Sheet2")


For r = 2 To rs1.Range("A" & Rows.Count).End(xlUp).Row

rs2.[K2] = rs1.Cells(r, "A").Value
rs3.Cells(r, "A") = rs2.[K14].Value

Next r

MsgBox "Done"

End Sub

hth,
-Ross
Can you insert the names of my worksheets and cells into what you sent? I’m new to coding and am not quite sure how to insert it.
Thank you!
 

BRE3

New Member
Joined
Apr 17, 2020
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Can you insert the names of my worksheets and cells into what you sent? I’m new to coding and am not quite sure how to insert it.
Thank you!
Never mind I didn’t read the whole thing!
 

BRE3

New Member
Joined
Apr 17, 2020
Messages
4
Office Version
  1. 365
Platform
  1. Windows
try this:
VBA Code:
Sub Do_it()

Dim rs1, rs2, rs3 As Worksheet
Set rs1 = Worksheets("CP Report Pull")
Set rs2 = Worksheets("Week View")
Set rs3 = Worksheets("Sheet2")


For r = 2 To rs1.Range("A" & Rows.Count).End(xlUp).Row

rs2.[K2] = rs1.Cells(r, "A").Value
rs3.Cells(r, "A") = rs2.[K14].Value

Next r

MsgBox "Done"

End Sub

hth,
-Ross
This worked! Thank you Ross!
 

Watch MrExcel Video

Forum statistics

Threads
1,113,936
Messages
5,545,104
Members
410,656
Latest member
Hydraulics
Top