Copy Cells from columns to rows

[Skipc]

I need A1:A3 then A4:A6 then A7:A8 copied to Row ?(1,3), row ? (1,3), row ? (1,3) depending on the row heading, then delete cell color and Print sheet: Can anyone help with some generic code for me Please!!! ie.
A1
A2 2.
A3 $1.5
A4
A5
A6 $3.0
A7
A8
A9 $4.5

Family Type Pounds Pric
C A 2.5 $1.5
P B 2 $3.0
M C 4 $4.50

 

[keepitcool]

Sub Test()
Dim v
v = ListToTable([a1].currentregion, 3)
[a1].currentregion.clear
[a1].Resize(UBound(v, 1), UBound(v, 2)) = v
End Sub

Function ListToTable(oriTable As Range, numFields As Integer)
Dim newTable As Variant, r As Long, c As Integer
ReDim newTable(1 To (1 + oriTable.Rows.Count \ numFields), 1 To
numFields)
For r = 1 To oriTable.Rows.Count Step numFields
For c = 1 To numFields
newTable(1 + r \ numFields, c) = oriTable(r + c - 1, 1)
Next
Next
ListToTable = newTable
End Function


keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >

 

[Skipc]

Thanks Keep: I left out that this has to happen from sheet1 into sheet2 sorry. Where would that go in the code

SkipC

 

[keepitcool]

well... i did put it in a function...
try:

Sub Test2()
Dim v
v = ListToTable([sheet1!a1].currentregion, 3)
[sheet2!a1].Resize(UBound(v, 1), UBound(v, 2)) = v
End Sub



keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >

 

[Skipc]

Thanks Cool: Yoou've been a great help

Skipc