My ugly as sin/ clumsy macro

I have a macro that I've basically thrashed together by recording individual bits in excel and pasting them together, I know thue look of it would probably upset anyone who knows VBA but I don't and I need to know two things:

1)

How can I avoid having to close the worksheet (without saving it) and then re-opening it so I can paste in the next set of data?

2)

Can I speed it up?

This is an example of the data followed by the code:

cl 31-40
sw 1.1
20
21
22
23
24
25
26
27
28 1
29
30
31 2
32 7
33 13
34 9
35 15
36 15
37 7
38 4
39
40 2
41 1
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

Sub Unbin()
'
' Unbin Macro
' Macro recorded 02/08/2001 by Ward
'

'
Range("A3:a63").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=90
Range("A64").Select
ActiveSheet.paste
Range("B64").Select
ActiveCell.FormulaR1C1 = "=OFFSET(RC[-1],-1,1)-1"
Range("B64").Select
Selection.AutoFill Destination:=Range("B64:B124"), Type:=xlFillDefault
Range("B64:B124").Select
Range("B64").Select
ActiveCell.FormulaR1C1 = "=OFFSET(RC[-1],-1,1)-1"
Range("B64").Select
Selection.AutoFill Destination:=Range("B64:B124"), Type:=xlFillDefault
Range("B64:B124").Select
Range("D3").Select
ActiveCell.FormulaR1C1 = "=MAX(RC[-2]:R[60]C[-2])"
Range("E3").Select
ActiveCell.FormulaR1C1 = "=(RC[-1]-1)*61+63"
ActiveWindow.LargeScroll Down:=0
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = 56
Range("A64:B124").Select
Selection.Copy
ActiveWindow.LargeScroll Down:=2
Range("A125:B" & (Range("D3").Value - 1) * 61 + 63).Select
ActiveSheet.paste
Range("a3:b" & (Range("D3").Value - 1) * 61 + 63).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'modified from http://support.microsoft.com/support/kb/articles/Q213/5/44.asp
'see http://www.geocities.com/davemcritchie/excel/delempty.htm

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'pre XL97 xlManual
Dim rng As Range, i As Long '// modified

'Set the range to evaluate to rng. // modified
Set rng = Intersect(Selection, ActiveSheet.UsedRange)
If rng Is Nothing Then
MsgBox "nothing in Intersected range to be checked"
GoTo done
End If

'Loop backwards through the rows
'in the range that you want to evaluate.
'--- For i = rng.Rows.Count To 1 Step -1 // modified

For i = rng.count To 1 Step -1

'If cell i in the range contains an "0", delete the entire row.
If rng.Cells(i).Value <= "0" Then rng.Cells(i).EntireRow.Delete
Next
done:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

'calculates which cells still active in column A and names the array "cl".

ActiveWorkbook.Names.Add Name:="CL", RefersToR1C1:= _
"=OFFSET(Sheet1!R1C1,2,0,COUNTA(Sheet1!C1),1)"

'Runs the descriptive statistics module

Run "Descr", ActiveSheet.Range("cl"), _
ActiveSheet.Range("$E$1"), "C", False, True, , , 95

Range("$E:$F").Select
Selection.Columns.AutoFit

End Sub