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

Status
Not open for further replies.

harky

Active Member
Joined
Apr 8, 2010
Messages
405
Office Version
  1. 2021
  2. 2019
Platform
  1. Windows
Hi, i need some help. But not sure if someone able to help me.
I using excel 2010.

This is how my data is
AEYiH3W.jpg


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


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.)
Q1WJf3r.jpg


will appreciate someone could help me. thanks million
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
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:
Upvote 0
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
 
Upvote 0
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)
OBpJS6c.jpg


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
 
Upvote 0
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
 
Upvote 0
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:
Upvote 0
You're welcome
You can change that line to any column you like to care of excess data.
 
Upvote 0
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:
Upvote 0
Status
Not open for further replies.

Forum statistics

Threads
1,213,484
Messages
6,113,923
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top