PDA

View Full Version : Transfer data from adjacent cells to non-adjacent cells



YasserKhalil
07-20-2017, 06:11 AM
Hello everyone
I have devised that code that enables me to transfer data from adjacent cells to non-adjacent cells


Sub Test()
Dim a As Variant
Dim b As Variant
Dim i As Long
Dim x As Long

a = Range("H12:H16").Value
ReDim b(1 To UBound(a, 1) * 2, 1 To UBound(a, 2))

For i = LBound(b, 1) To UBound(b, 1) Step 2
x = x + 1
b(i, 1) = a(x, 1)
Next i

Range("N12").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub


Is there a simpler way to achieve that?

YasserKhalil
07-20-2017, 06:18 AM
I have found a simpler code


Sub Demo()
Dim a As Variant

a = Split(Join(Application.Transpose(Range("H12:H16")), ",,"), ",")
Range("N12").Resize(UBound(a) + 1).Value = Application.Transpose(a)
End Sub


But I welcome any other solutions

snb
07-20-2017, 12:24 PM
or


Sub M_snb()
[N12:N20] = [choose(row(1:9),H12,"",H13,"",H14,"",H15,"",H16)]
End Sub

YasserKhalil
07-20-2017, 12:35 PM
That's great but the original source is about 100 values and it will be exhausted to refer to each cell individually ..

mdmackillop
07-20-2017, 01:33 PM
Sub Test()
Set a = Range("H12").CurrentRegion
Set b = Range("N16")
For i = 0 To a.Cells.Count - 1
b.Offset(2 * i) = a(i + 1)
Next i
End Sub

YasserKhalil
07-20-2017, 02:06 PM
Thank you very much Mr. mdmackillop (Your name is difficult for me .. but I promise I will keep it by heart)

mdmackillop
07-20-2017, 02:57 PM
MD are my initials, MacKillop the surname

YasserKhalil
07-20-2017, 11:27 PM
It is honor to know about you Mr. MD Mackillop
Thanks a lot for your great efforts