Need to repeat relative macro for next row of data until next row is null

[syfyfan1980]

I am new to writing / recording macros and have had some success with simple macros. My macro below works by coping all the cells in a row on sheet2 to cells on sheet1. I recorded the macro using relative referencing as I need to repeat the macro for the data in rows 2, 3, 4 etc in sheet2. The cells being copied to on sheet1 are not all in the same row but are in different rows and columns making most cut and paste macros useless. To keep things simple, I created a sample spreadsheet that does the same thing as my working spreadsheet. The real spreadsheet has several hundred cells being copied and my sample has 6, but same theory.

Can someone in this group provide me with an example of code that will repeat my relative copy paste macro row by row until there is a blank row in sheet2 ?

Thanks in advance,

Syfyfan1980

The macro below copies my data correctly and when I highlight the first cell in row 2 in sheet2 and run the macro again, it correctly copies the data into the second repeated section on sheet1. I just to automate the re-running of the macro.
================================================

Sub Macro11()
'
' Macro11 Macro
'

'
Selection.Copy
Sheets("Sheet1").Select
ActiveSheet.Paste Link:=True
Sheets("Sheet2").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveSheet.Paste Link:=True
Sheets("Sheet2").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
ActiveCell.Offset(-1, 2).Range("A1").Select
ActiveSheet.Paste Link:=True
Sheets("Sheet2").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste Link:=True
Sheets("Sheet2").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste Link:=True
Sheets("Sheet2").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste Link:=True
Range("B6").Select
End Sub

 

[DanteAmor]

How about:

Sub Repeat_Copy()
  Dim i As Long
  With Sheets("Sheet1")
    For i = 1 To .Range("A" & Rows.Count).End(3).Row Step 5
      Sheets("Sheet2").Range("A" & Rows.Count).End(3)(2).Resize(1, 6).Value = Array(.Cells(i, "B"), _
      .Cells(i + 2, "B"), .Cells(i + 1, "D"), .Cells(i + 2, "D"), .Cells(i + 3, "D"), .Cells(i + 4, "D"))
    Next
  End With
End Sub

 

[syfyfan1980]

How about:

Sub Repeat_Copy()
  Dim i As Long
  With Sheets("Sheet1")
    For i = 1 To .Range("A" & Rows.Count).End(3).Row Step 5
      Sheets("Sheet2").Range("A" & Rows.Count).End(3)(2).Resize(1, 6).Value = Array(.Cells(i, "B"), _
      .Cells(i + 2, "B"), .Cells(i + 1, "D"), .Cells(i + 2, "D"), .Cells(i + 3, "D"), .Cells(i + 4, "D"))
    Next
  End With
End Sub

Dante, I really appreciate the quick reply to my post and excuse my ignorance, but I don't know where to insert the macro you provided into my working macro. I have tried adding at the top and bottom of my macro but my macro still does not loop. When I copy your code (macro) at the nd of my macro below the last End Sub, your macro shows up by name in my macro list but does not automatically exceute. Can you advise what I am doing wrong? My expectation was that your macro gets embedded somewhere inside the first or last lines of my macro so that when I execute Macro11, it does the first copy paste and then continues to the next row of data until it hits an empty row.

Thanks very much,

syfyfan1980 (James)

 

[DanteAmor]

Do not worry.
My macro replaces your macro.
Just run my macro. The macro copies all the records from sheet1 to sheet2.