How to make this excel macro repeat on the next line until there is no more Data in column A?

Waffles255

New Member
Joined
Mar 30, 2019
Messages
26
Office Version
  1. 2019
am fairly new to VBA what i am hopping to do is to make this macro recording code repeat this on the Cell 1 then Cell 2 Then Cell 3 until there is no more data fields left in the A col. Basically its supposed to copy a Cell in A1 and copy to book 2 then hit refresh data then copy some Info back into Book1 and repeat from A1 until there is no more cells with data left in the A column
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Sub Macro1()
'
' Macro1 Macro
'

'
Range
("A2").Select
Selection
.Copy
Windows
("Book2").Activate
Range
("A2").Select
Selection
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application
.CutCopyMode = False
ActiveWorkbook
.RefreshAll
Windows
("Book1").Activate
Range
("F2").Select
Windows
("Book2").Activate
Range
("K6").Select
Selection
.Copy
Windows
("Book1").Activate
Selection
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Windows
("Book2").Activate
Range
("L6").Select
Application
.CutCopyMode = False
Selection
.Copy
Windows
("Book1").Activate
Range
("G2").Select
Selection
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range
("G3").Select
End Sub</code>
Thanks in advance
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Welcome to the forum.


Try this

Code:
Sub Macro2()
    '
    Dim wb1 As Workbook, wb2 As Workbook
    Dim sh1 As Worksheet, sh2 As Worksheet
    
    Set wb1 = ThisWorkbook
    Set wb2 = Workbooks("Book2")
    Set sh1 = wb1.Sheets(1)
    Set sh2 = wb2.Sheets(1)
    
    For Each c In Range("A2", sh1.Range("A" & Rows.Count).End(xlUp))
        sh2.Range("A2").Value = c.Value
        wb2.RefreshAll
        
        sh1.Cells(c.Row, "F").Value = sh2.Range("K6").Value
        sh1.Cells(c.Row, "G").Value = sh2.Range("L6").Value
    Next
    MsgBox "Done"
End Sub
 
Upvote 0
I did not understand

sh1.Cells(c.Row, "F").Value = sh2.Range("K6").Value sh1.Cells(c.Row, "G").Value = sh2.Range("L6").Value

Would it be possible to change the k6 and L6 to look for the last data in in Column K6 and K7 example :

[TABLE="width: 192"]
<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl63, width: 64"]


[/TD]
[TD="class: xl63, width: 64"]K[/TD]
[TD="class: xl63, width: 64"]L[/TD]
[/TR]
[TR]
[TD="class: xl64"]5[/TD]
[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]
[/TR]
[TR]
[TD="class: xl64"]6[/TD]
[TD="class: xl63"]Data 1[/TD]
[TD="class: xl63"]Date 1[/TD]
[/TR]
[TR]
[TD="class: xl64"]7[/TD]
[TD="class: xl63"]Data 2[/TD]
[TD="class: xl63"]Date 2[/TD]
[/TR]
[TR]
[TD="class: xl64"]8[/TD]
[TD="class: xl63"]Data 3[/TD]
[TD="class: xl63"]Date 3[/TD]
[/TR]
[TR]
[TD="class: xl64"]9[/TD]
[TD="class: xl63"]Data 4[/TD]
[TD="class: xl63"]Date 4[/TD]
[/TR]
</tbody>[/TABLE]

Then instead of returning Data 1 and Date 2 it returns Data 4 and Date 4 because its the last in the list?

Thank you so much for all the help!!
 
Upvote 0
Try this

Code:
Sub Macro2()
    '
    Dim wb1 As Workbook, wb2 As Workbook
    Dim sh1 As Worksheet, sh2 As Worksheet
[COLOR=#0000ff]    Dim lr As Long[/COLOR]
    
    Set wb1 = ThisWorkbook
    Set wb2 = Workbooks("Book2")
    Set sh1 = wb1.Sheets(1)
    Set sh2 = wb2.Sheets(1)
    
    For Each c In Range("A2", sh1.Range("A" & Rows.Count).End(xlUp))
        sh2.Range("A2").Value = c.Value
        wb2.RefreshAll
[COLOR=#0000ff]        lr = sh2.Range("K" & Rows.Count).End(xlUp).Row[/COLOR]
        sh1.Cells(c.Row, "F").Value = sh2.Range([COLOR=#0000ff]"K" & lr[/COLOR]).Value
        sh1.Cells(c.Row, "G").Value = sh2.Range([COLOR=#0000ff]"L" & lr[/COLOR]).Value
    Next
    MsgBox "Done"
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,908
Messages
6,175,306
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top