Ingresar información vertical según criterios o búsquedas

Sub Mes()
    Dim Celda As Object
    Dim Rango As Range
   
        'Set Rango = Range("D2:D12")
    Application.Calculation = xlCalculationManual
        
        'Rango donde se encuentra la información:
        Range("m5").End(xlDown).Select
        'Rango donde se anotará la nueva información:
        Set Rango = ActiveSheet.Range(Cells(5, 2), Cells((ActiveCell.Row), 2))
    
        'Rango de análisis de la información:
        For Each Celda In Rango
        Celda.Value = Format(Left(Celda.Offset(0, 12).Value, 2), "00")
        'Celda.Value = Celda.Offset(0, -2).Value + Celda.Offset(0, -1).Value
        Next Celda
        Application.Calculation = xlCalculationAutomatic

        
End Sub

Sub BuscarConcepto()
    Dim Celda As Object
    Dim Rango As Range
   
   Application.Calculation = xlCalculationManual
        
       
        'Rango donde se encuentra la información:
        Range("m5").End(xlDown).Select
        'Rango donde se anotará la nueva información:
        Set Rango = ActiveSheet.Range(Cells(5, 11), Cells((ActiveCell.Row), 11))
    
        'Rango de análisis de la información:
        
        On Error GoTo Error
        For Each Celda In Rango
        If Celda.Offset(0, -3).Value = "    " Then
        Celda.Value = ""
        Else
        Celda.Value = Application.WorksheetFunction.VLookup(Celda.Offset(0, -2).Value, Hoja6.Range("a:u"), 21, 0)
        End If
        Next Celda
        On Error GoTo 0
        
        Application.Calculation = xlCalculationAutomatic
    Exit Sub
    
Error:
    Celda.Value = "0 No encontrado"
    Resume Next
    
    Application.Calculation = xlCalculationAutomatic
       
End Sub