Simple Macro to "Lookup -> Repeat"

[James8309]

Hi everyone,

I have two sheets in my workbook containing addresses.

i.e.
- Sheet("A") containing addresses from cell E2 downwards.
- Sheet("B") capturing addresses from Sheet("A") from cell A5


How do I capture original address(unique address) from Sheet("A") and
repeat it eight times in Sheet("B") from cell A5 downards and move on
to the next unique address on Sheet("A").

e.g.
If Range("E2:E5") in Sheet("A") are as below:

E2: Brisbane (59)
E3: Brisbane (79)
E4: Perth (20)
E5: Sydney (30)


I want Sheet("B") from A5 to be as below:

A5: Brisbane (59)
A6: Brisbane (59)
A7: Brisbane (59)
A8: Brisbane (59)
A9: Brisbane (59)
A10: Brisbane (59)
A11: Brisbane (59)
A12: Brisbane (59)
A13: Brisbane (79)
A14: Brisbane (79)
A15: Brisbane (79)
A16: Brisbane (79)
A17: Brisbane (79)
A18: Brisbane (79)
A19: Brisbane (79)
A20: Brisbane (79)

and so on...

Thank you for your help in advance.


Regards,


James

 

[The Code Cage Team]

Perhaps something like this:

Sub copycells()
Dim Rng As Range, Rng1 As Long
Dim MyCell As Range, oCell As Range
Dim i As Long
Set Rng = Sheets("Sheet1").Range("E2:E" & Range("E" &
Rows.Count).End(xlUp))
For Each MyCell In Rng
Rng1 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(0,
1).Row
MyCell.Copy Destination:=Sheets("Sheet2").Range(Cells(Rng1, 1),
Cells(Rng1 + 8, 1))
Next
End Sub


--
The Code Cage Team

Regards,
The Code Cage Team
'The Code Cage' (http://www.thecodecage.com)

 

[Jarek Kujawa]

try:

Sub cus()
Dim counter As Integer
Dim i As Integer
Dim cell As Range

For Each cell In Sheets("A").Columns(5).Cells
If Len(cell) > 0 Then
For i = 1 To 8
counter = counter + 1
Sheets("B").Cells(4 + counter, 1) = cell
Next i
Else
Exit Sub
End If
Next cell

End Sub

 

[Jarek Kujawa]

replace

For Each cell In Sheets("A").Columns(5).Cells

with

For Each cell In Sheets("A").Range("E2:E10000").Cells

 

[Tim Williams]

Untested...

Tim

'*******************************
dim rngSrc as range, rngDest as range

set rngSrc = sheets("A").range("E2")
set rngDest= sheets("B").Range("A5")

Do While rngSrc.value<>""
rngDest.resize(5,1).value=rngSrc.value
set rngSrc=rngSrc.offset(1,0)
set rngDest=rngDest.offset(5,0)
Loop
'*******************************