Help with building macro to create new rows and copy and paste cell content into new rows

EPTowers

New Member
Joined
Jan 25, 2014
Messages
5
Hello, I have been manually doing a process all day long and I want a macro that allows me to highlight a row and do the actions automatically. Can someone on the board take a look at this and help me make a macro?

The column looks like this originally:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Serial[/TD]
[TD]Date[/TD]
[TD]Title[/TD]
[TD]Name A[/TD]
[TD]Name B[/TD]
[TD]Name C[/TD]
[/TR]
</tbody>[/TABLE]

The new columns look like this when I'm done formatting:
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD]Title[/TD]
[TD]Name B[/TD]
[TD]Name C[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Title[/TD]
[TD]Name A[/TD]
[TD]Name C[/TD]
[/TR]
[TR]
[TD]Serial[/TD]
[TD]Date[/TD]
[TD]Title[/TD]
[TD]Name A[/TD]
[TD]Name B[/TD]
[/TR]
</tbody>[/TABLE]

Here is what my repetitive action looks like when I record it as a macro:
Sub Macro4()'
' Macro4 Macro
'


'
Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("4:4").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C5").Select
Selection.Copy
Range("C3:C4").Select
Range("C4").Activate
ActiveSheet.Paste
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Range("D4").Select
ActiveSheet.Paste
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Range("D3").Select
ActiveSheet.Paste
Range("F5").Select
Application.CutCopyMode = False
Selection.Copy
Range("E3:E4").Select
ActiveSheet.Paste
Range("F5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
This solution assumes that you have selected the entire row that you want to modify. This is generic so that you can use it regardless of the row you select.

Code:
Sub FormatRows()    Dim s As Range
    
    Set s = Selection
    
    Range(s.Row & ":" & s.Row + 1).Insert Shift = xlDown
    Range(Cells(s.Row - 2, 3), Cells(s.Row - 1, 3)).Value = Range(Cells(s.Row, 3), Cells(s.Row, 3)).Value
    Range(Cells(s.Row - 1, 4), Cells(s.Row - 1, 4)).Value = Range(Cells(s.Row, 4), Cells(s.Row, 4)).Value
    Range(Cells(s.Row - 2, 4), Cells(s.Row - 2, 4)).Value = Range(Cells(s.Row, 5), Cells(s.Row, 5)).Value
    Range(Cells(s.Row - 2, 5), Cells(s.Row - 1, 5)).Value = Range(Cells(s.Row, 6), Cells(s.Row, 6)).Value
    Range(Cells(s.Row, 6), Cells(s.Row, 6)).Value = ""
End Sub
 
Upvote 0
Thanks for the help but I guess I am just too new at this to get it to work.
I opened VB editor, pasted the code in, and tried to run it on my row but I got back an error. Is there something I'm missing?
 
Upvote 0
I just tried it on my windows computer and now it WORKS! Crystalyzer, I owe you an ice cream or a chocolate milk because you just saved me days of work! You are special and awesome, keep up the good work!
 
Upvote 0

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

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