Macro help: Transpose row to column & Copy, paste data

Status
Not open for further replies.

harky

Active Member
Joined
Apr 8, 2010
Messages
313
Hi, i need some help. But not sure if someone able to help me.
I using excel 2010.

This is how my data is


The Macro will Transpose COL E (Font format had to retain (like colour, bold or underline)


Once transpose, marco will copy and paste the main row data and fill up the blank.

(like u see in the pic, which highlighted in yellow are filled up base on the main row.)


will appreciate someone could help me. thanks million
 

Some videos you may like

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

harky

Active Member
Joined
Apr 8, 2010
Messages
313
No it diff, pivot table can't fill up the column which is blank which you see on 2nd pic.

Pivot table is reverse the whole set of data which already exist but my is based on column E

I want the script to transpose base on column E and copy paste and fill up the blank base on the main row.

The last pic is the final result.
 
Last edited:

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG28Jun44
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Lstcol [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Application.ScreenUpdating = False
Lst = Range("A" & Rows.Count).End(xlUp).Row
[COLOR="Navy"]For[/COLOR] n = Lst To 2 [COLOR="Navy"]Step[/COLOR] -1
    Lstcol = Cells(n, Columns.Count).End(xlToLeft).Column - 5
    [COLOR="Navy"]With[/COLOR] Cells(n, 1).EntireRow
        .Copy
        Cells(n + 1, 1).Resize(Lstcol).EntireRow.Insert shift:=xlDown
        Cells(n, 6).Resize(, Lstcol).Copy
        Cells(n + 1, 5).PasteSpecial Transpose:=True
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n
Columns("F:M").EntireColumn.Delete
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

harky

Active Member
Joined
Apr 8, 2010
Messages
313
Thanks Mick.
This works base on my image1 data, but i had issue here. I notice it cannot ignore if there is data like this.

row 3 (if there is data on Col E onward, it will need to Transpose, copy & paste. if there is only 1 data on col E, thn ignore, no copy paste needed)


Try this:-
Code:
[COLOR=Navy]Sub[/COLOR] MG28Jun44
[COLOR=Navy]Dim[/COLOR] Lst [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Lstcol [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
Application.ScreenUpdating = False
Lst = Range("A" & Rows.Count).End(xlUp).Row
[COLOR=Navy]For[/COLOR] n = Lst To 2 [COLOR=Navy]Step[/COLOR] -1
    Lstcol = Cells(n, Columns.Count).End(xlToLeft).Column - 5
    [COLOR=Navy]With[/COLOR] Cells(n, 1).EntireRow
        .Copy
        Cells(n + 1, 1).Resize(Lstcol).EntireRow.Insert shift:=xlDown
        Cells(n, 6).Resize(, Lstcol).Copy
        Cells(n + 1, 5).PasteSpecial Transpose:=True
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]Next[/COLOR] n
Columns("F:M").EntireColumn.Delete
Application.ScreenUpdating = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG29Jun29
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Lstcol [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Application.ScreenUpdating = False
Lst = Range("A" & Rows.Count).End(xlUp).Row
[COLOR="Navy"]For[/COLOR] n = Lst To 2 [COLOR="Navy"]Step[/COLOR] -1
    Lstcol = Cells(n, Columns.Count).End(xlToLeft).Column - 5
    [COLOR="Navy"]With[/COLOR] Cells(n, 1).EntireRow
        [COLOR="Navy"]If[/COLOR] Lstcol > 0 [COLOR="Navy"]Then[/COLOR]
            .Copy
            Cells(n + 1, 1).Resize(Lstcol).EntireRow.Insert shift:=xlDown
            Cells(n, 6).Resize(, Lstcol).Copy
            Cells(n + 1, 5).PasteSpecial Transpose:=True
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n
Columns("F:M").EntireColumn.Delete
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

harky

Active Member
Joined
Apr 8, 2010
Messages
313
Sorry for late reply. Mick it works great.
but i notice this line.

Columns("F:M").EntireColumn.Delete

So this will delete Col F to M.
Possible to delete anyhow after Col E? as my last col may not be M


Try this:-
Code:
[COLOR=Navy]Sub[/COLOR] MG29Jun29
[COLOR=Navy]Dim[/COLOR] Lst [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Lstcol [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
Application.ScreenUpdating = False
Lst = Range("A" & Rows.Count).End(xlUp).Row
[COLOR=Navy]For[/COLOR] n = Lst To 2 [COLOR=Navy]Step[/COLOR] -1
    Lstcol = Cells(n, Columns.Count).End(xlToLeft).Column - 5
    [COLOR=Navy]With[/COLOR] Cells(n, 1).EntireRow
        [COLOR=Navy]If[/COLOR] Lstcol > 0 [COLOR=Navy]Then[/COLOR]
            .Copy
            Cells(n + 1, 1).Resize(Lstcol).EntireRow.Insert shift:=xlDown
            Cells(n, 6).Resize(, Lstcol).Copy
            Cells(n + 1, 5).PasteSpecial Transpose:=True
        [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]Next[/COLOR] n
Columns("F:M").EntireColumn.Delete
Application.ScreenUpdating = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Last edited:

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
You're welcome
You can change that line to any column you like to care of excess data.
 

harky

Active Member
Joined
Apr 8, 2010
Messages
313
hmm

i add one more column.
So now is not column E but F
and start off at A4

how to edit the code :)

You're welcome
You can change that line to any column you like to care of excess data.
 
Last edited:
Status
Not open for further replies.

Watch MrExcel Video

Forum statistics

Threads
1,102,050
Messages
5,484,417
Members
407,438
Latest member
DKrakken

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top