Alternative macro to replace multiple for loops in vlookup to enable code to execute faster

Is there a better way to rewrite the code (reduce the loops) so that the code could finished executing it at a faster rate?

Currently, the code takes about an average 5 - 10 mins depending on the rows being input. My Destwb is about 56k KB (quite a huge file). 

There are 4 different loops for 4 different criteria; LOD1, DC1, DC2 and MISC and it is taking quite fair bit of time despite the results are populating correctly.

Option Compare Text
Sub vlkuptoDCconsol()
    
    Application.ScreenUpdating = False
    
    Dim ws          As Worksheet
    Dim Destwb      As Workbook
    Dim Destws      As Worksheet
    Dim wsrng       As Range
    Dim wsrng2       As Range
    Dim wsrng3       As Range
    Dim wsrng4       As Range
    Dim i           As Long
    Dim DestwslastRow As Long
    Dim DestwslastRow2 As Long
    
    Dim find_LOD1   As Range
    Dim find_DC2    As Range
    Dim find_DC1    As Range
    Dim find_MISC   As Range
    
    Dim LOD1_startrow As Long
    Dim LOD1_lastrow As Long
    Dim DC2_startrow As Long
    Dim DC2_lastrow As Long
    Dim DC1_startrow As Long
    Dim DC1_lastrow As Long
    Dim MISC_startrow As Long
    Dim MISC_lastrow As Long
    
    Dim str         As String
    
    str = InputBox("Has Column B being sorted? Y/N")
    
    If str = "N" Then
        
        Exit Sub
        
    Else
        
        On Error Resume Next
        
        Set ws = ThisWorkbook.Sheets("Return To vlkup DC consol")
        
        Set Destwb = Workbooks.Open("\\fenton801\CorpSVC2\Finance\Systems-Risk-ERM\OrderToCash\C2C\Misc files\DC consol - Mobile Consumer.xlsx")
        Set Destws = Destwb.Sheets("Rapid - List With DC")
        Set find_LOD1 = ws.Cells.Find(What:="LOD1", After:=ws.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
            xlPart, MatchCase:=False)
        
        DestwslastRow = Destws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        
        If Not find_LOD1 Is Nothing Then
            
            LOD1_startrow = ws.Range("B:B").Find(What:="LOD1", After:=ws.Range("B1")).Row
            LOD1_lastrow = ws.Range("B:B").Find(What:="LOD1", After:=ws.Range("B1"), SearchDirection:=xlPrevious).Row
            Destws.Range("J:K").EntireColumn.Insert
            Set wsrng = ws.Range("D" & LOD1_startrow & ":P" & LOD1_lastrow)
            
            For i = 2 To DestwslastRow
                
                Destws.Range("J" & i).Value = Application.WorksheetFunction.VLookup(Destws.Range("A" & i).Value, wsrng, 12, 0)
                Destws.Range("J:J").NumberFormat = "dd-Mmm-yy"
                
                Destws.Range("K" & i).Value = Application.WorksheetFunction.VLookup(Destws.Range("A" & i).Value, wsrng, 13, 0)
                
            Next i
            
            Destws.AutoFilter.Sort.SortFields. _
                                               Clear
            Destws.AutoFilter.Sort.SortFields. _
                                               Add2 Key:=Range("J1"), SortOn:=xlSortOnValues, Order:=xlAscending, _
                                               DataOption:=xlSortNormal
            With Destws.AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            DestwslastRow2 = Destws.Cells(Destws.Rows.Count, "J").End(xlUp).Row
            
            Destws.Range("J2:K" & DestwslastRow2).Copy
            Destws.Range("L2:M" & DestwslastRow2).PasteSpecial xlValues
            Destws.Range("J:K").EntireColumn.Delete
            
        End If
        
        Set find_DC2 = ws.Cells.Find(What:="DC2", After:=ws.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
            xlPart, MatchCase:=False)
        
        DestwslastRow = Destws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        
        If Not find_DC2 Is Nothing Then
            DC2_startrow = ws.Range("B:B").Find(What:="DC2", After:=ws.Range("B1")).Row
            DC2_lastrow = ws.Range("B:B").Find(What:="DC2", After:=ws.Range("B1"), SearchDirection:=xlPrevious).Row
            Destws.Range("AA:AB").EntireColumn.Insert
            Set wsrng2 = ws.Range("D" & DC2_startrow & ":P" & DC2_lastrow)
            
            For i = 2 To DestwslastRow
                
                Destws.Range("AA" & i).Value = Application.WorksheetFunction.VLookup(Destws.Range("A" & i).Value, wsrng2, 12, 0)
                Destws.Range("AA:AA").NumberFormat = "dd-Mmm-yy"
                
                Destws.Range("AB" & i).Value = Application.WorksheetFunction.VLookup(Destws.Range("A" & i).Value, wsrng2, 13, 0)
                
            Next i
            Destws.AutoFilter.Sort.SortFields. _
                                               Clear
            Destws.AutoFilter.Sort.SortFields. _
                                               Add2 Key:=Range("AA1"), SortOn:=xlSortOnValues, Order:=xlAscending, _
                                               DataOption:=xlSortNormal
            With Destws.AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            
            DestwslastRow2 = Destws.Cells(Destws.Rows.Count, "AA").End(xlUp).Row
            
            Destws.Range("AA2:AB" & DestwslastRow2).Copy
            Destws.Range("AC2:AD" & DestwslastRow2).PasteSpecial xlValues
            Destws.Range("AA:AB").EntireColumn.Delete
            
        End If
        
        Set find_DC1 = ws.Cells.Find(What:="DC1", After:=ws.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
            xlPart, MatchCase:=False)
        
        DestwslastRow = Destws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        
        If Not find_DC1 Is Nothing Then
            DC1_startrow = ws.Range("B:B").Find(What:="DC1", After:=ws.Range("B1")).Row
            DC1_lastrow = ws.Range("B:B").Find(What:="DC1", After:=ws.Range("B1"), SearchDirection:=xlPrevious).Row
            Destws.Range("T:U").EntireColumn.Insert
            Set wsrng3 = ws.Range("D" & DC1_startrow & ":P" & DC1_lastrow)
            
            For i = 2 To DestwslastRow
                
                Destws.Range("T" & i).Value = Application.WorksheetFunction.VLookup(Destws.Range("A" & i).Value, wsrng3, 12, 0)
                Destws.Range("T:T").NumberFormat = "dd-Mmm-yy"
                
                Destws.Range("U" & i).Value = Application.WorksheetFunction.VLookup(Destws.Range("A" & i).Value, wsrng3, 13, 0)
                
            Next i
            Destws.AutoFilter.Sort.SortFields. _
                                               Clear
            Destws.AutoFilter.Sort.SortFields. _
                                               Add2 Key:=Range("T1"), SortOn:=xlSortOnValues, Order:=xlAscending, _
                                               DataOption:=xlSortNormal
            With Destws.AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            
            DestwslastRow2 = Destws.Cells(Destws.Rows.Count, "T").End(xlUp).Row
            
            Destws.Range("T2:U" & DestwslastRow2).Copy
            Destws.Range("V2:W" & DestwslastRow2).PasteSpecial xlValues
            Destws.Range("T:U").EntireColumn.Delete
            
        End If
        
        Set find_MISC = ws.Cells.Find(What:="MISC", After:=ws.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
            xlPart, MatchCase:=False)
        
        DestwslastRow = Destws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        
        If Not find_MISC Is Nothing Then
            DC1_startrow = ws.Range("B:B").Find(What:="MISC", After:=ws.Range("B1")).Row
            DC1_lastrow = ws.Range("B:B").Find(What:="MISC", After:=ws.Range("B1"), SearchDirection:=xlPrevious).Row
            Destws.Range("J:K").EntireColumn.Insert
            Set wsrng4 = ws.Range("D" & DC1_startrow & ":P" & DC1_lastrow)
            
            For i = 2 To DestwslastRow
                
                Destws.Range("J" & i).Value = Application.WorksheetFunction.VLookup(Destws.Range("A" & i).Value, wsrng4, 12, 0)
                Destws.Range("J:J").NumberFormat = "dd-Mmm-yy"
                
                Destws.Range("K" & i).Value = Application.WorksheetFunction.VLookup(Destws.Range("A" & i).Value, wsrng4, 13, 0)
                
            Next i
            Destws.AutoFilter.Sort.SortFields. _
                                               Clear
            Destws.AutoFilter.Sort.SortFields. _
                                               Add2 Key:=Range("J1"), SortOn:=xlSortOnValues, Order:=xlAscending, _
                                               DataOption:=xlSortNormal
            With Destws.AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            
            DestwslastRow2 = Destws.Cells(Destws.Rows.Count, "J").End(xlUp).Row
            
            Destws.Range("J2:K" & DestwslastRow2).Copy
            Destws.Range("L2:M" & DestwslastRow2).PasteSpecial xlValues
            Destws.Range("J:K").EntireColumn.Delete
            
        End If
        
    End If
    
    Application.ScreenUpdating = True
    
End Sub

Appreciate the help in advance!