estatefinds
07-22-2017, 01:36 PM
I have maccro that currently puts columns to rows from Column A, to B and C , and D
I need the maccro to be restructured to copy the Rows from within the range of E1 to AL9548 , (But only the data that is highlighted) to be placed in the designated Column AN. I am attaching file.
Thank you very much in advance!!!
here is the code I currently have
[Sub movetocolumns()Dim i As Integer, iRow As Integer
Dim arrSource As Variant
'Set the first row
iRow = 1
With ActiveWorkbook.Worksheets("Sheet1")
'get the data into an array from the first column
arrSource = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
'parse every value of the array and add the data to the next column
For i = 1 To (UBound(arrSource) - UBound(arrSource) Mod 3) Step 3
.Cells(iRow, 2) = arrSource(i, 1)
.Cells(iRow, 3) = arrSource(i + 1, 1)
.Cells(iRow, 4) = arrSource(i + 2, 1)
iRow = iRow + 1
Next i
'add the remaining values
Select Case UBound(arrSource) Mod 3
Case 1 'one item to add
.Cells(iRow, 2) = arrSource(i, 1)
Case 2 'still two items to add
.Cells(iRow, 2) = arrSource(i, 1)
.Cells(iRow, 3) = arrSource(i + 1, 1)
Case Else 'nothing to add
End Select
End With
End Sub]
I need the maccro to be restructured to copy the Rows from within the range of E1 to AL9548 , (But only the data that is highlighted) to be placed in the designated Column AN. I am attaching file.
Thank you very much in advance!!!
here is the code I currently have
[Sub movetocolumns()Dim i As Integer, iRow As Integer
Dim arrSource As Variant
'Set the first row
iRow = 1
With ActiveWorkbook.Worksheets("Sheet1")
'get the data into an array from the first column
arrSource = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
'parse every value of the array and add the data to the next column
For i = 1 To (UBound(arrSource) - UBound(arrSource) Mod 3) Step 3
.Cells(iRow, 2) = arrSource(i, 1)
.Cells(iRow, 3) = arrSource(i + 1, 1)
.Cells(iRow, 4) = arrSource(i + 2, 1)
iRow = iRow + 1
Next i
'add the remaining values
Select Case UBound(arrSource) Mod 3
Case 1 'one item to add
.Cells(iRow, 2) = arrSource(i, 1)
Case 2 'still two items to add
.Cells(iRow, 2) = arrSource(i, 1)
.Cells(iRow, 3) = arrSource(i + 1, 1)
Case Else 'nothing to add
End Select
End With
End Sub]