How to copy and paste in a loop in a set of 3 cells

[cubs786]

Hi,

I have an excel with lots of data but the data is in columns (each column has 10,000 or more data points), such as:

7.52
7.56
7.56
7.55
7.35

and I want copy the first three cells and transpose them on a different excel file, such as

7.52, 7.56, 7.56
7.56, 7.55, 7.35

But I want to do the whole column instead of manually copying and pasting three cells at a time.

I will be using a macro to do this job.

I know how to copy and paste the first three cells using macro but I want to continue all of the data to run in a loop to finish the job automatically or there is any other to do this?

thanks.

 

[DanteAmor]

The source column 1, do you want it in the destination columns 1,2 and 3, where do you want the origin column 2, in destination columns 4,5 and 6?How many origin columns do you have?

 

[kweaver]

Via Non-Macro:

If you put this formula in the first cell where you want the result(s) to be, fill across 2 more cells so you have the formula in 3 cells, then fill down as many as the (#rows)/3 or until you get all 0s in the rows.

=INDEX($A:$A,ROW(A1)*3-3+COLUMN(A1))

You could incorporate a test for all 0s and blank them or do whatever.

 

[DanteAmor]

If so, try this
change sheet1 by the name of your source sheet

(2 columns with 10,000 records each, processed in 5 seconds)

Sub set3column()
    Dim l1 As Workbook, l2 As Workbook, sh1 As Worksheet, sh2 As Worksheet
    Dim i As Long, j As Long, k As Long, c As Long
    
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set sh1 = l1.Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
    Set l2 = Workbooks.Add
    Set sh2 = l2.Sheets(1)
    
    c = 1
    For j = 1 To sh1.Cells(1, Columns.Count).End(xlToLeft).Column
        k = 1
        For i = 1 To sh1.Cells(Rows.Count, j).End(xlUp).Row Step 3
            sh2.Cells(k, c).Resize(1, 3).Value = WorksheetFunction.Transpose(sh1.Cells(i, j).Resize(3, 1).Value)
            k = k + 1
        Next
        c = c + 3
    Next
    MsgBox "End"
End Sub

 

[kweaver]

I had a different macro approach which seemed to work if I understand the OP correctly.

Sub TransposeBy3()
Dim LR As Long
LR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
LR = LR / 3
Sheets("Sheet1").Range("C1:E1").Formula = "=INDEX($A:$A,ROW(A1)*3-3+COLUMN(A1))"
Range("C1:E1").Select
Selection.AutoFill Destination:=Range("C1:E" & LR)
End Sub

 

[cubs786]

The source column 1, do you want it in the destination columns 1,2 and 3, where do you want the origin column 2, in destination columns 4,5 and 6?How many origin columns do you have?

column A

7.52
7.56
7.56
7.55
7.35

I want to have it in the same excel file


B C D
7.52, 7.56, 7.56
7.56, 7.55, 7.35

Hopefully it clears it up

 

[kweaver]

AH, the 3rd value becomes the first in the next set of 3 transpositions?!?!?

 

[cubs786]

I apologize for the typo but it should be the fourth one.

7.52
7.56
7.56
7.55
7.35
7.25


B C D
7.52, 7.56, 7.56
7.55, 7.35, 7.25

 

[kweaver]

Then I think my formulas or my macro will do it for you, right? I just tried 10005 cells and the macro did it instantaneously.

 

[cubs786]

Thanks, it's working perfectly fine. but is there a way to add if and else statement to take out the zeros at the end.

73.53906	73.53636	73.55796	73.44028	73.48685	73.53033	73.58295	73.49767
73.5328	73.48087	73.53788	73.50001	73.51572	73.56081	73.53013	73.52189
73.47843	73.56998	73.55529	73.49907	73.50033	73.55747	73.51356	73.55635
73.55299	73.53053	73.56288	73.52654	73.49673	73.53942	73.5472	73.54499
73.54589	73.52994	73.53255	73.47897	73.51845	73.48042	73.52837	73.49318
73.54636	73.50286	73.49793	73.5041	73.54249	73.48727	73.46145	73.48816
73.53129	73.56045	73.54726	73.45769	73.51023	73.50892	73.58716	73.49274
73.50082	73.52829	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0

<colgroup><col width="72" span="8" style="width:54pt"> </colgroup><tbody>
</tbody>