请教vba问题，下面代码如何改进(标签-VBA|关键词-VBA)

Question

我想提取我想要的列到新的工作表的指定区域，能否帮忙改进一下,我这个只能提取行。
Private Sub Worksheet_Activate()
Dim sh As Worksheet
Dim DeSh As Worksheet
Dim x As Integer
Dim StartRow As Long
Dim Last As Long
Dim shLast As Long
Dim firstblankrow As Long
Dim CopyRng As Range
On Error Resume Next

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Set DeSh = Me
Last = LastRow(DeSh)
If Last >= 1 Then
    Rows("3:" & Last).Delete
End If
Last = 1
For Each sh In Sheets(Array("1.c", "2.c", "3.c", 4.c"))
    firstblankrow = sh.Range("B1").End(xlDown).Row - 1
    StartRow = 2
    If firstblankrow > 0 And firstblankrow > StartRow Then
        For x = 10 To 20000
            If sh.Cells(x, 2) <> sh.Cells(x, 5) Then
            Set CopyRng = sh.Range(sh.Rows(x), sh.Rows(x))

            CopyRng.Copy
            With DeSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = xlCopy
                DeSh.Cells(Last + 1, LastColumn(DeSh)).Select
                DeSh.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & sh.Name & "'" & "!B1", TextToDisplay:=sh.Name
            End With
            Last = LastRow(DeSh)
            End If
        Next
    End If
Next

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True

ExitSub:
Application.Goto DeSh.Cells(1)
DestSh.Columns.AutoFit
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next

LastRow = sh.Cells.Find(what:="*", after:=sh.Range("A1"), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False).Row

End Function

Function LastColumn(sh As Worksheet)
On Error Resume Next

LastColumn = sh.Cells.Find(what:="*", after:=sh.Range("A1"), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False).Column