transpose some group of cells

%3CLINGO-SUB%20id%3D%22lingo-sub-1354529%22%20slang%3D%22en-US%22%3Etranspose%20some%20group%20of%20cells%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1354529%22%20slang%3D%22en-US%22%3E%3CP%3EI've%20been%20surfing%20on%20the%20internet%20but%20I%20can't%20find%20the%20exact%20answer%20to%20my%20problem.%20I%20want%20to%20transpose%20%22some%20group%20of%20cells%22%20that%20you%20can%20look%20at%20my%20screenshot%20below.%20Is%20that%20any%20fastest%20way%20to%20do%20that%3F%20Thank%20you.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1354529%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EFormulas%20and%20Functions%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1354897%22%20slang%3D%22en-US%22%3ERe%3A%20transpose%20some%20group%20of%20cells%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1354897%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F645041%22%20target%3D%22_blank%22%3E%40aldias21%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EPlease%20find%20the%20Macro-Enabled%20Excel%20Workbook%20with%20a%20button%20called%20%22Transpose%20Data%22%20on%20Sheet1.%3C%2FP%3E%3CP%3EYou%20may%20click%20this%20button%20to%20run%20the%20macro%20which%20will%20transpose%20the%20numbers%20entered%20in%20column%20A%20in%20the%20desired%20format.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThe%20code%20underneath%20the%20button%20is%20as%20below...%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-visual%22%3E%3CCODE%3ESub%20TransposeData()%0ADim%20i%20%20%20As%20Long%0ADim%20j%20%20%20As%20Long%0ADim%20lr%20%20As%20Long%0ADim%20x%20%20%20As%20Variant%0A%0AApplication.ScreenUpdating%20%3D%20False%0A%0A'Finding%20the%20last%20row%20with%20number%20in%20column%20A%0Alr%20%3D%20Cells(Rows.Count%2C%20%22A%22).End(xlUp).Row%0A%0A'Clearing%20the%20destination%20range%0ARange(%22C%3AE%22).Clear%0A%0AReDim%20x(1%20To%20(lr%20%2F%203)%20%2B%202%2C%201%20To%203)%0A%0AFor%20i%20%3D%201%20To%20lr%20Step%203%0A%20%20%20%20j%20%3D%20j%20%2B%201%0A%20%20%20%20x(j%2C%201)%20%3D%20Cells(i%2C%201)%0A%20%20%20%20x(j%2C%202)%20%3D%20Cells(i%20%2B%201%2C%201)%0A%20%20%20%20x(j%2C%203)%20%3D%20Cells(i%20%2B%202%2C%201)%0ANext%20i%0A%0ARange(%22C1%22).Resize(j%2C%203).Value%20%3D%20x%0A%0AApplication.ScreenUpdating%20%3D%20True%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1354906%22%20slang%3D%22en-US%22%3ERe%3A%20transpose%20some%20group%20of%20cells%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1354906%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F645041%22%20target%3D%22_blank%22%3E%40aldias21%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20see%20you%20have%202013.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E365%20solution%20if%20you%20upgrade%3A%3C%2FP%3E%3CP%3E%3CSPAN%20class%3D%22lia-inline-image-display-wrapper%20lia-image-align-inline%22%20image-alt%3D%22Patrick2788_0-1588429998980.png%22%20style%3D%22width%3A%20400px%3B%22%3E%3CIMG%20src%3D%22https%3A%2F%2Fgxcuf89792.i.lithium.com%2Ft5%2Fimage%2Fserverpage%2Fimage-id%2F188381iE0A38F6CBBBD9DE1%2Fimage-size%2Fmedium%3Fv%3D1.0%26amp%3Bpx%3D400%22%20title%3D%22Patrick2788_0-1588429998980.png%22%20alt%3D%22Patrick2788_0-1588429998980.png%22%20%2F%3E%3C%2FSPAN%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E
Highlighted
Occasional Visitor

I've been surfing on the internet but I can't find the exact answer to my problem. I want to transpose "some group of cells" that you can look at my screenshot below. Is that any fastest way to do that? Thank you.

2 Replies
Highlighted

@aldias21 

Please find the Macro-Enabled Excel Workbook with a button called "Transpose Data" on Sheet1.

You may click this button to run the macro which will transpose the numbers entered in column A in the desired format.

 

The code underneath the button is as below...

 

Sub TransposeData()
Dim i   As Long
Dim j   As Long
Dim lr  As Long
Dim x   As Variant

Application.ScreenUpdating = False

'Finding the last row with number in column A
lr = Cells(Rows.Count, "A").End(xlUp).Row

'Clearing the destination range
Range("C:E").Clear

ReDim x(1 To (lr / 3) + 2, 1 To 3)

For i = 1 To lr Step 3
    j = j + 1
    x(j, 1) = Cells(i, 1)
    x(j, 2) = Cells(i + 1, 1)
    x(j, 3) = Cells(i + 2, 1)
Next i

Range("C1").Resize(j, 3).Value = x

Application.ScreenUpdating = True
End Sub

 

 

Highlighted

@aldias21 

I see you have 2013.

 

365 solution if you upgrade:

Patrick2788_0-1588429998980.png