VBA Relative Cell Reference and Loop until end of data

How can I take this macro I recorded and change to use relative cell reference in place of hard coded "Range" and loop until end of data. The actual document has 10x more data.
My File is attached. I want to take Step 2 and create Step 3 Auto-Magically!

Sub TrmShrt3()
'
' TrmShrt3 Macro
'
    Sheets("Step 2").Select
    Sheets("Step 2").Copy Before:=Sheets(1)
    Sheets("Step 2 (2)").Select
    Sheets("Step 2 (2)").Name = "Step 3"
    Range("B1:B9").Select
    Selection.Copy
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("C1:C9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("C10:C18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D3").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("C19:C27").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D4").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("C28:C36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C28:C36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D5").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=6
    Range("C37:C45").Select
    ActiveWindow.SmallScroll Down:=3
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-18
    Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=21
    Range("C46:C54").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-27
    Range("D7").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=36
    Range("C55:C63").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-45
    Range("D8").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=54
    Range("C64:C72").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-57
    Range("D9").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=54
    Range("C73:C81").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-78
    Range("D10").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Columns("A:C").Select
    Range("C1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("E14").Select
    Cells.Replace What:="""", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Hi, does this do what you want?

HTML Code: