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

[EPTowers]

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:

Serial

Date

Title

Name A

Name B

Name C

<tbody>
</tbody>

The new columns look like this when I'm done formatting:

		Title	Name B	Name C
		Title	Name A	Name C
Serial	Date	Title	Name A	Name B

<tbody>
</tbody>

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

 

[Crystalyzer]

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.

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

 

[EPTowers]

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?

 

[EPTowers]

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!