very complex Macro, need to add sort .need to add Find and replace,

[Jerk24]

Ok, First i have a Word report i copy over to the original macro1 and macro 2 and it cleans it up for me, next (where i could use a updated macro) then i copy to a new sheet and sort on Column A and remove all the data that (in this case, the line starting PM and below--- all data for the rest of the sheet)

the next step is moving data in column M to another sheet (added to end of Macro2) which replaces everything in this column, and then i copy and paste back. is there a way to combine all of this?

please see below macro1,2 and the UIC macro which needs to be at the end. But am still missing how to sort on Column A, inbetween the Macro2 and UIC.

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 6/3/2009 by NYARNG
'
'

Worksheets(1).Range("A1:Q" & Worksheets(1).Range("Q65536").End(xlUp).Row).ClearContents


End Sub
Sub Macro2()
'
' Macro2 Macro
' Macro recorded 6/3/2009 by NYARNG
'
Range("A1").Select
Columns("A:A").EntireColumn.AutoFit
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(2, 2), Array(17, 2), Array(23, 2), Array(26, 2), _
Array(31, 2), Array(36, 2), Array(45, 2), Array(50, 2), Array(55, 2), Array(62, 2), Array( _
66, 2), Array(76, 2), Array(82, 2), Array(93, 2), Array(103, 2), Array(117, 2)), _
TrailingMinusNumbers:=True
Cells.Select
Cells.EntireColumn.AutoFit
'
Dim res As Range
Dim tmp As String
Dim sw As Worksheet
Dim dw(2) As Worksheet
Dim dlRow(2) As Integer
Dim cd As Integer
Set sw = Worksheets(1)
Set dw(0) = Worksheets(2)
Set dw(1) = Worksheets(3)
dlRow(0) = 1
dlRow(1) = 1

dw(0).Range("A2:Q" & dw(0).Range("Q65536").End(xlUp).Row).ClearContents
dw(1).Range("A2:Q" & dw(1).Range("Q65536").End(xlUp).Row).ClearContents

Dim Lrow As Long
Lrow = sw.Range("Q65536").End(xlUp).Row

For Each s In sw.Range("a1:a" & Lrow)
If (Not sw.Range("q" & s.Row).Find(".", LookIn:=xlValues) Is Nothing) And (sw.Range("q" & s.Row).Find("$", LookIn:=xlValues) Is Nothing) Then
tmp = sw.Range("b" & s.Row).Value
If Left(tmp, 2) = "W1" Or Left(tmp, 4) = "MIPR" Or Left(tmp, 3) = "MOD" Or Left(tmp, 3) = "LOA" Or Left(tmp, 3) = "GTR" Then
cd = 1
Else
cd = 0
End If
For Each c In sw.Range("a" & s.Row & ":q" & s.Row)
dw(cd).Cells(dlRow(cd) + 1, c.Column) = c
Next
dlRow(cd) = dlRow(cd) + 1
ElseIf Not sw.Range("q" & s.Row).Find("-", LookIn:=xlValues) Is Nothing Then
'this line and totals line following it go same place as last row
For Each c In sw.Range("n" & s.Row & ":q" & s.Row)
dw(cd).Cells(dlRow(cd) + 1, c.Column) = c
'dw(cd).Cells(dlRow(cd) + 2, c.Column) = c.Offset(1, 0)
Next
dlRow(cd) = dlRow(cd) + 1
Set res = sw.Range("q" & s.Row & ":q" & Lrow).Find("$", LookIn:=xlValues)
If Not res Is Nothing Then
For Each c In sw.Range("n" & res.Row & ":q" & res.Row)
dw(cd).Cells(dlRow(cd) + 1, c.Column) = c
Next
dlRow(cd) = dlRow(cd) + 1
End If
End If


Next
End Sub
Sub uic()
Dim subs
Set subs = Sheet2
Set r = subs.Range("B2:" & subs.Range("C2").End(xlDown).Address)
For i = 1 To r.Rows.Count
Sheet1.Range("D3:" & Sheet1.Range("D3").End(xlDown).Address).Select
Selection.Replace What:=r.Cells(i, 1), Replacement:=r.Cells(i, 2), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next

End Sub