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

[Waffles255]

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

 

[DanteAmor]

Welcome to the forum.


Try this

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

 

[Waffles255]

Thank you so much for this and the fast reply!!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[Waffles255]

Just one last thing can we make it that it returns the last line in Sh2 column F and G?

 

[DanteAmor]

I did not understand

 

[Waffles255]

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 :

	K	L
5
6	Data 1	Date 1
7	Data 2	Date 2
8	Data 3	Date 3
9	Data 4	Date 4

<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>
</tbody>

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!!

 

[DanteAmor]

Try this

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

 

[Waffles255]

It Works perfectly thank you, you made my Day!

 

[DanteAmor]

You're welcome.