Transpose Column to Rows

hardeep.kanwar · Sep 15, 2011

Hi! Experts

I have data in Column A and Column B

See the Example

Now, I want to Transpose the Column B into another Sheet

Excel Workbook

A

B

1

Record

Details

2

Name

amruta jagtap42986

3

Email

amrutaj100@rediffmail.com

4

Phone

8055523115

5

Gender

Female

6

Desired Course

MBA/PGDM

7

Mode

Full Time

8

Current Location

All Mumbai

9

Preferred Locations

All Mumbai

10

Date of Registration

14th Sep 2011

11

12

Name

KRISHNA59028

13

Email

KRISHNAGOJE11@GMAIL.COM

14

Phone

9533866967

15

Desired Course

MBA/PGDM

16

Mode

Full Time

17

Current Location

Andhra Pradesh - Other

18

Preferred Locations

Hyderabad

19

Date of Registration

14th Sep 2011

20

21

Name

pankaj gadgul96032

22

Email

pgadgul@gmail.com

23

Phone

9945079470

24

Gender

Male

25

Desired Course

MBA/PGDM

26

Mode

Part Time

27

Current Location

Bangalore

28

Preferred Locations

Pune,Bangalore,Hyderabad

29

30

Name

Hazra79419

31

Email

hazrakhatoon@yahoo.com

32

Phone

9007324142

33

Gender

Female

34

Desired Course

Diploma in Fashion Design

35

Current Location

Kolkata

36

Preferred Locations

Kolkata

37

Date of Registration

14th Sep 2011

38

39

Name

Nidhi Khanna41911

40

Email

rachalkhanna@ymail.com

41

Phone

9212114490

42

Gender

Female

43

Desired Course

Diploma in Fashion Design

44

Mode

Part Time

45

Current Location

Delhi

46

Date of Registration

14th Sep 2011

Sheet2

This is the Format in Sheet 2 Row 1

Excel Workbook

E

F

G

H

I

J

K

L

M

N

1

Name

Email

Phone

Gender

Desired Course

Mode

Current Location

Preferred Locations

Date of Registration

Sheet1

Expected Result

<table style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; " border="1" cellpadding="0" cellspacing="0"><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td></tr><tr style="height:29px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">
</td><td style="font-weight:bold; font-family:Arial; font-size:9pt; text-align:center; ">
</td><td style="color:#0000ff; text-decoration:underline; text-align:center; ">
</td><td style="font-weight:bold; font-family:Arial; font-size:9pt; text-align:center; ">
</td><td style="font-weight:bold; font-family:Arial; font-size:9pt; text-align:center; ">
</td><td style="font-weight:bold; font-family:Arial; font-size:9pt; text-align:center; ">
</td><td style="font-weight:bold; font-family:Arial; font-size:9pt; text-align:center; ">
</td><td style="font-weight:bold; font-family:Arial; font-size:9pt; text-align:center; ">
</td><td style="font-weight:bold; font-family:Arial; font-size:9pt; text-align:center; ">
</td><td style="font-weight:bold; font-family:Arial; font-size:9pt; text-align:center; ">
</td></tr><tr style="height:18px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">
</td><td>
</td><td>
</td><td style="text-align:right; ">
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td></tr></table>
But, the Problem is the Format in not Same in Column A in Sheet1, See the Example No. 2 & 3 , there are only 8 Fields, 1 Field is Missing

Excel Workbook

D

E

F

G

H

I

J

K

L

1

Name

Email

Phone

Gender

Desired Course

Mode

Current Location

Preferred Locations

Date of Registration

2

amruta jagtap42986

amrutaj100@rediffmail.com

8055523115

Female

MBA/PGDM

Full Time

All Mumbai

14th Sep 2011

3

KRISHNA59028

KRISHNAGOJE11@GMAIL.COM

9533866967

MBA/PGDM

Full Time

Andhra Pradesh - Other

Hyderabad

14th Sep 2011

4

pankaj gadgul96032

pgadgul@gmail.com

9945079470

Male

MBA/PGDM

Part Time

Bangalore

Pune,Bangalore,Hyderabad

5

Hazra79419

hazrakhatoon@yahoo.com

9007324142

Female

Diploma in Fashion Design

Kolkata

14th Sep 2011

Sheet2

See the Highlited Rows

villy · Sep 15, 2011

Try...

Code:

Sub trans()
    
    Set sh = Sheets(2)
    sh.Cells.ClearContents
    Range("A2:A9").Copy
    sh.Range("A1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
    lr = sh.Cells(Rows.Count).End(xlUp).Row
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step 9
    Set A_Rng = Range("A" & i)
    Set B_Rng = Range("B" & i)
    Set B2_Rng = sh.Range("A" & lr + 1)
    
    Range("B" & i & ":B" & i + 7).Copy
    B2_Rng.PasteSpecial Paste:=xlPasteAll, Transpose:=True
    lr = lr + 1
Next
End Sub

Assuming that column A have the same fields as headers

hardeep.kanwar · Sep 16, 2011

villy said:

Try...

Code:

Sub trans()
    
    Set sh = Sheets(2)
    sh.Cells.ClearContents
    Range("A2:A9").Copy
    sh.Range("A1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
    lr = sh.Cells(Rows.Count).End(xlUp).Row
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step 9
    Set A_Rng = Range("A" & i)
    Set B_Rng = Range("B" & i)
    Set B2_Rng = sh.Range("A" & lr + 1)
    
    Range("B" & i & ":B" & i + 7).Copy
    B2_Rng.PasteSpecial Paste:=xlPasteAll, Transpose:=True
    lr = lr + 1
Next
End Sub

Assuming that column A have the same fields as headers

Sorry for Delay Reply

The Main Problem is the Header are not Same

See the Example no.2 and 3, i.e. A12:A19 and A21:A28

jbeaucaire · Sep 16, 2011

Try this, it will find the correct spot for any header location:

Code:

Option Explicit

Sub ColumnsToRows()
Dim LR As Long, NR As Long, Rw As Long
Dim wsData As Worksheet, wsOUT As Worksheet
Dim HdrCol As Range, Hdr As String

Set wsData = Sheets("Sheet2")
Set wsOUT = Sheets("Sheet1")
LR = wsData.Range("A" & Rows.Count).End(xlUp).Row
NR = wsOUT.Range("E" & Rows.Count).End(xlUp).Row

On Error Resume Next
For Rw = 1 To LR
    Hdr = wsData.Range("A" & Rw).Value
    If Hdr = "Name" Then NR = NR + 1
    If Hdr <> "" And Hdr <> "Record" Then
        Set HdrCol = wsOUT.Range("1:1").Find(Hdr, _
                LookIn:=xlValues, LookAt:=xlWhole)
        If Not HdrCol Is Nothing Then
            wsOUT.Cells(NR, HdrCol.Column).Value = wsData.Range("B" & Rw).Value
            Set HdrCol = Nothing
        End If
    End If
Next Rw

wsOUT.Columns.AutoFit
End Sub

jbeaucaire · Sep 16, 2011

This slight tweak also allows you to set the "string" at the top of the macro that will "reset" each time and create a new output row. This means nothing on the OUTPUT sheet is hardcoded, it's all variable and self-correcting.

Rich (BB code):

Option Explicit

Sub ColumnsToRows()
Dim LR As Long, NR As Long, Rw As Long
Dim wsData As Worksheet, wsOUT As Worksheet
Dim HdrCol As Range, Hdr As String, strRESET As String

Set wsData = Sheets("Sheet2")   'source data
Set wsOUT = Sheets("Sheet1")    'output sheet
strRESET = "Name"               'this value will cause the record row to increment
LR = wsData.Range("A" & Rows.Count).End(xlUp).Row   'end of incoming data

Set HdrCol = wsOUT.Range("1:1") _
    .Find(strRESET, LookIn:=xlValues, LookAt:=xlWhole)
If HdrCol Is Nothing Then
    MsgBox "The key string '" & strRESET & "' could not be found on the output sheet."
    Exit Sub
End If

NR = wsOUT.Cells(Rows.Count, HdrCol.Column).End(xlUp).Row   'current output end of data
Set HdrCol = Nothing

On Error Resume Next
For Rw = 1 To LR
    Hdr = wsData.Range("A" & Rw).Value
    If Hdr = "Name" Then NR = NR + 1
    If Hdr <> "" And Hdr <> "Record" Then
        Set HdrCol = wsOUT.Range("1:1").Find(Hdr, _
                LookIn:=xlValues, LookAt:=xlWhole)
        If Not HdrCol Is Nothing Then
            wsOUT.Cells(NR, HdrCol.Column).Value = wsData.Range("B" & Rw).Value
            Set HdrCol = Nothing
        End If
    End If
Next Rw

wsOUT.Columns.AutoFit
End Sub

hardeep.kanwar · Sep 17, 2011

jbeaucaire said:

This slight tweak also allows you to set the "string" at the top of the macro that will "reset" each time and create a new output row. This means nothing on the OUTPUT sheet is hardcoded, it's all variable and self-correcting.

Rich (BB code):

Option Explicit

Sub ColumnsToRows()
Dim LR As Long, NR As Long, Rw As Long
Dim wsData As Worksheet, wsOUT As Worksheet
Dim HdrCol As Range, Hdr As String, strRESET As String

Set wsData = Sheets("Sheet2")   'source data
Set wsOUT = Sheets("Sheet1")    'output sheet
strRESET = "Name"               'this value will cause the record row to increment
LR = wsData.Range("A" & Rows.Count).End(xlUp).Row   'end of incoming data

Set HdrCol = wsOUT.Range("1:1") _
    .Find(strRESET, LookIn:=xlValues, LookAt:=xlWhole)
If HdrCol Is Nothing Then
    MsgBox "The key string '" & strRESET & "' could not be found on the output sheet."
    Exit Sub
End If

NR = wsOUT.Cells(Rows.Count, HdrCol.Column).End(xlUp).Row   'current output end of data
Set HdrCol = Nothing

On Error Resume Next
For Rw = 1 To LR
    Hdr = wsData.Range("A" & Rw).Value
    If Hdr = "Name" Then NR = NR + 1
    If Hdr <> "" And Hdr <> "Record" Then
        Set HdrCol = wsOUT.Range("1:1").Find(Hdr, _
                LookIn:=xlValues, LookAt:=xlWhole)
        If Not HdrCol Is Nothing Then
            wsOUT.Cells(NR, HdrCol.Column).Value = wsData.Range("B" & Rw).Value
            Set HdrCol = Nothing
        End If
    End If
Next Rw

wsOUT.Columns.AutoFit
End Sub

Sir You are a Genius, You are Really Life Save for Me

Thank you Very Much Sir

ray:

Transpose Column to Rows

hardeep.kanwar

Well-known Member

Excel Facts

villy

Active Member

hardeep.kanwar

Well-known Member

jbeaucaire

Well-known Member

jbeaucaire

Well-known Member

hardeep.kanwar

Well-known Member

Similar threads

Forum statistics

Share this page

Transpose Column to Rows

hardeep.kanwar

Well-known Member

Excel Facts

villy

Active Member

hardeep.kanwar

Well-known Member

jbeaucaire

Well-known Member

jbeaucaire

Well-known Member

hardeep.kanwar

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock