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
 

Some videos you may like

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
770
Office Version
  1. 2013
Platform
  1. Windows
Hi
Try
VBA Code:
Sub test()
    Dim a, b
    Dim i, x
    ReDim a(1 To 734 - 2 / 2)
    With Sheets("sheet1")
        For i = 1 To UBound(a)
            a(i) = .Cells(1 + i * 2, 2).Resize(2, 9)
        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)
            Next
        End Sub
 
Last edited:

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
770
Office Version
  1. 2013
Platform
  1. Windows
OOOPs
Correction
VBA Code:
Sub test()
    Dim a, b
    Dim i, x
    ReDim a(1 To 734 - 2 / 2)
    With Sheets("sheet1")
        For i = 1 To UBound(a)
            a(i) = .Cells(1 + i * 2, 2).Resize(2, 9)
        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)
            Next
        End With
    End With
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
50,563
Office Version
  1. 365
Platform
  1. Windows
@mohadin
As the data is going out to column IZ, don't you need to change the resize?
 

bunburyst

New Member
Joined
Apr 18, 2018
Messages
15

ADVERTISEMENT

Hey, thanks for your help.
The macro works but does not continue through the rest of the cells and rows. This is the result:
4.jpg


I remember you that i have data range b3:iz734
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
770
Office Version
  1. 2013
Platform
  1. Windows
Just change to
VBA Code:
            a(i) = .Cells(1 + i * 2, 2).Resize(2, 261)
so sorry for this
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
770
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

@Fluff
Good point but why not
 

bunburyst

New Member
Joined
Apr 18, 2018
Messages
15
Just change to
VBA Code:
            a(i) = .Cells(1 + i * 2, 2).Resize(2, 261)
so sorry for this
Thanks my friend but the macro does not continue with the rest of the rows. The macro stops when transposing the data in rows 3 and 4.
The macro should continue through rows 5 and 6, etc.

:(
 

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)
            Next
        End With
    End With
End Sub
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
770
Office Version
  1. 2013
Platform
  1. Windows
Again
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
        End With
    End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,118,134
Messages
5,570,349
Members
412,320
Latest member
sixnine0312
Top