=ЕСЛИ(ЕОШИБКА(ВПР($A3;СводМи!$A$ 3 :$V$ 85 ;СТОЛБЕЦ()- 1 ;ЛОЖЬ));"";ВПР($A3;СводМи!$A$ 3 :$V$ 85 ;СТОЛБЕЦ()- 1 ;ЛОЖЬ))

Option Explicit

Sub Месяц2()
    Dim mStr As String 'искомая стр
    Dim mRowNum As Long 'номер строки
    Dim mRowCnt As Long 'число строк
    Dim mColCnt As Long 'число колонок
    Dim mCopNum As Long 'номер копии
    Dim str As Variant
    Dim qs As Long
    Dim shSource As Worksheet, shDest As Worksheet
    str = Time
    Application.ScreenUpdating = False
    'qs = 4
    mCopNum =  0 
    Set shSource = ActiveWorkbook.Worksheets("СводМИ")
    Set shDest = ActiveWorkbook.Sheets("222")
    mRowCnt = shSource.Cells.SpecialCells(xlLastCell).Row
    mColCnt = shDest.Cells.SpecialCells(xlLastCell).Column

    For qs =  2  To mRowCnt
        mStr = shSource.Cells(qs,  1 ).Value
        For mRowNum =  2  To mRowCnt
            If shDest.Cells(mRowNum,  1 ).Value = mStr Then
                    With shDest
                        .Range(.Cells(qs,  3 ), .Cells(qs, mColCnt)).Value = shSource.Range(shSource.Cells(mRowNum,  2 ), 
shSource.Cells(mRowNum, mColCnt)).Value
                    End With
                 Exit For
             End If
        Next mRowNum
    Next qs
Application.ScreenUpdating = True
MsgBox Format(Time - str, "hh:mm:ss")
End Sub


Sub Месяц2_find()
    Dim mStr As String 'искомая стр
    Dim mRowNum As Long 'номер строки
    Dim mRowCnt As Long 'число строк
    Dim mColCnt As Long 'число колонок
    Dim mCopNum As Long 'номер копии
    Dim str As Variant
    Dim qs As Long

    Dim shSource As Worksheet, shDest As Worksheet, r As Range
    str = Time
    Application.ScreenUpdating = False
    'qs = 4
    mCopNum =  0 
    Set shSource = ActiveWorkbook.Worksheets("СводМИ")
    Set shDest = ActiveWorkbook.Sheets("222")
    mRowCnt = shDest.Cells.SpecialCells(xlLastCell).Row
    mColCnt = shSource.Cells.SpecialCells(xlLastCell).Column

    For qs =  2  To mRowCnt
        Set r = shSource.Range("A:A").Find(What:=shDest.Cells(qs,  1 ).Text, LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
        :=False, SearchFormat:=False)
        If Not r Is Nothing Then
            With shDest
                .Range(.Cells(qs,  3 ), .Cells(qs, mColCnt)).Value = shSource.Range(shSource.Cells(r.Row,  2 ), 
shSource.Cells(r.Row, mColCnt)).Value
            End With
        End If
    Next qs
Application.ScreenUpdating = True
MsgBox Format(Time - str, "hh:mm:ss")
End Sub

Application.ScreenUpdating = False
> > >    Application.Calculation = xlCalculationManual
....
> > >Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True