Problema con una formula

Que tal compañeros probando unas macros e intentado realizar un proceso, poseo 2 macros las cuales funcionan perfectamente y logran lo que necesito pero ejecutando una por una e tratado de unirlas pero el resultado es distinto alguien me podría ayudar

Modulo 1 ( este código funciona bien, si lo realizo por partes. Cuando lo integro no funciona, porque?)

Sub Macro3()
Cells.Select
 ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
 ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
 "P:P"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 With ActiveWorkbook.ActiveSheet.Sort
 .SetRange Range("A1:Z42")
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
 Rows("2:3").Select
 Selection.ClearContents
 Cells.Select
 ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
 ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
 "A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 With ActiveWorkbook.ActiveSheet.Sort
 .SetRange Range("A:Z")
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
 ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
 ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
 "P:P"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
 xlSortNormal
 With ActiveWorkbook.ActiveSheet.Sort
 .SetRange Range("A:Z")
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
 Range("A1").Select
End Sub
Sub celda()
Range("P2").Select
 While ActiveCell <> ""
 'ActiveCell.Offset(1, 0).Select
 If ActiveCell = "Unidades" Then
 ActiveCell.Offset(1, 0).Select
 Else
 ActiveCell.Delete Shift:=xlToLeft
 End If
 Wend
End Sub