VBA transpose data rows to 2 columns

bunburyst

New Member
Joined
Apr 18, 2018
Messages
15
Hi, please, I need a vba code to transpose my data
from the following in sheet 1:

Data range is B3:IZ734

1.jpg


to the following in sheet 2:

2.jpg


A working code would be greatly appreciated,

Tks.

Remy
 

bunburyst

New Member
Joined
Apr 18, 2018
Messages
15
@mohadin , thanks so much, macro work perfectly!, Just one more thing, when transposing the dates the format is not respected. For example, January 2, 2016 becomes 01/02/2016, american format. I need to respect the dates, european format. 02/01/2016
 

Some videos you may like

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
770
Office Version
  1. 2013
Platform
  1. Windows
VBA Code:
Sub test()
    Dim a, b
    Dim i, x
    Dim lr, lc
    With Sheets("sheet1")
        lr = .Cells(Rows.Count, 3).End(xlUp).Row
        lc = .Cells(3, Columns.Count).End(xlToLeft).Column
        ReDim a(1 To (lr - 2) / 2)
        For i = 1 To UBound(a)
            a(i) = .Cells(1 + i * 2, 2).Resize(2, lc)
        Next
        With Sheets("sheet2")
            For i = 1 To UBound(a)
                .Cells(3 + x, 2).Resize(UBound(a(i), 2), 2) = Application.Transpose(a(i))
                x = UBound(a(i), 2) + x - 1
            Next
            Columns("B:B").NumberFormat = "d/m/yyyy"
        End With
    End With
End Sub
 
Last edited:

bunburyst

New Member
Joined
Apr 18, 2018
Messages
15
Thanks my friend but It does not respect the date, the macro continues to transform the dates, for example, January 2 is transposed to February 1.
 

Dossfm0q

Active Member
Joined
Mar 9, 2009
Messages
478
Office Version
  1. 2019
Platform
  1. Windows
Option set up as Array formula

VBA Code:
Sub transpose_data_rows_to_2_columns()
Dim SourceRng As Range
Dim TrnspsRng As Range

    Set SourceRng = Worksheets("Sheet1").Range("B3:IZ734")
    Set TrnspsRng = Worksheets("Sheet2").Range(SourceRng.Cells(1, 1).Address).Resize(SourceRng.Columns.Count * (SourceRng.Rows.Count / 2), SourceRng.Rows.Count)
  
    ArrSrcRng = SourceRng.Parent.Name & "!" & SourceRng.Address
    RwNum = "ROW()-ROW(" & SourceRng.Cells(1, 1).Address & ")+1"
    
    TrnspsRng.Columns(1).Cells.FormulaArray = "=INDEX(" & ArrSrcRng & ",(CEILING(" & RwNum & ",COLUMNS(" & ArrSrcRng & "))/COLUMNS(" & ArrSrcRng & ")*2)-1,MOD(" & RwNum & "-1,COLUMNS(" & ArrSrcRng & "))+1)"
    TrnspsRng.Columns(2).Cells.FormulaArray = "=INDEX(" & ArrSrcRng & ",((CEILING(" & RwNum & ",COLUMNS(" & ArrSrcRng & "))/COLUMNS(" & ArrSrcRng & ")*2)-1)+1,MOD(" & RwNum & "-1,COLUMNS(" & ArrSrcRng & "))+1)"
  
End Sub
 
Solution

sandy666

Well-known Member
Joined
Oct 24, 2015
Messages
7,376

ADVERTISEMENT

maybe Power Query instead of vba
Column1Column2Column3Column4Column5Column6Column7Column8Column9Column10Column11Column1Column2
01/01/201601/01/201601/01/201601/01/201601/01/201601/01/201601/01/201601/01/201601/01/201601/01/201601/01/201601/01/201656
561753385154363042511701/01/201617
02/01/201602/01/201602/01/201602/01/201602/01/201602/01/201602/01/201602/01/201602/01/201602/01/201602/01/201601/01/201653
62141644255362848314901/01/201638
01/01/201651
01/01/201654
01/01/201636
01/01/201630
01/01/201642
01/01/201651
01/01/201617
02/01/201662
02/01/201614
02/01/201616
02/01/201644
02/01/201625
02/01/201653
02/01/201662
02/01/20168
02/01/201648
02/01/201631
02/01/201649

Power Query:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    FN = Table.FirstN(Source,2),
    TFN = Table.Transpose(FN),
    LN = Table.LastN(Source,2),
    TLN = Table.Transpose(LN),
    TC = Table.Combine({TFN, TLN}),
    Type = Table.TransformColumnTypes(TC,{{"Column1", type date}})
in
    Type
 

Dossfm0q

Active Member
Joined
Mar 9, 2009
Messages
478
Office Version
  1. 2019
Platform
  1. Windows
I am proud to serve you and I thank the other members for giving me advanced lessons
 

Watch MrExcel Video

Forum statistics

Threads
1,118,134
Messages
5,570,364
Members
412,321
Latest member
Yusuf_A
Top