Private Sub Command1_Click()

    Dim objExcel, objWorkbook As Workbook
    Dim objExcel2, objWorkbook2 As Workbook
    Set objExcel = CreateObject("EXCEL.APPLICATION")
    Set objExcel2 = CreateObject("EXCEL.APPLICATION")
    objExcel.Visible = False
    objExcel2.Visible = False
    Application.ScreenUpdating = False
    'Ïóòü ê èñõîäíîìó ôàéëó ïðåäûäóùåãî ìåñÿöà
    Set objWorkbook = objExcel.Workbooks.Open("C:\Users\Varina_LI\Desktop\ïðèìåð\ñåíòÿáðü.xlsx")
    'Ïóòü ê èñõîäíîìó ôàéëó òåêóùåãî ìåñÿöà
    Set objWorkbook2 = objExcel.Workbooks.Open("C:\Users\Varina_LI\Desktop\ïðèìåð\îêòÿáðü.xlsx")
    
    With objWorkbook.ActiveSheet
        d = .Cells(.Rows.Count, 5).End(xlUp).Row
        arrSrc = .Range("A1 :AA" & d).Value
    End With
    objWorkbook.Close savechanges:=False
    
    With objWorkbook2.ActiveSheet
        e = .Cells(.Rows.Count, 5).End(xlUp).Row
        arrSrc2 = .Range("A1 :AA" & e).Value
    End With
    objWorkbook2.Close savechanges:=False
    


    Dim arrRes()
    ReDim arrRes(1 To UBound(arrSrc), 1 To UBound(arrSrc, 2))
    

    For r = 1 To 22
        For i = 1 To UBound(arrSrc)
            For j = 1 To UBound(arrSrc2)
                Data = ""
                If arrSrc2(j, 1) <> arrSrc(i, 1) Then
                    If arrSrc2(j, 2) <> arrSrc(i, 2) Then
                        If arrSrc2(j, 3) <> arrSrc(i, 3) Then
                            If arrSrc2(j, 4) <> arrSrc(i, 4) Then
                    
                    Data = "'" & arrSrc2(j, r)
             
                            End If
                        End If
                    End If
                End If
            Next
        Next
    Next

   
    
    Application.ScreenUpdating = True
    Dim New_Wb As Workbook
    Dim f As Long
    Set New_Wb = Workbooks.Add
    New_Wb.ActiveSheet.Range("A1").Resize(UBound(arrRes), UBound(arrRes, 2)).Value = arrRes
    
'Ïóòü ãäå ñîçäàåòñÿ íîâûé ôàéë
    New_Wb.SaveAs FileName:="C:\Users\Varina_LI\Desktop\ïðèìåð\fizmen_ms21.xlsx"
    MsgBox "Ôàéë èçìåíåíèé äëÿ ÌÑ21 óñïåøíî ñôîðìèðîâàí"
    objExcel.ActiveWorkbook.Close savechanges:=False
        
End Sub

Sub МЯВ()
    Dim arr, arr1, arrEnd
    Dim wb1 As Workbook, wb2 As Workbook
    Dim lr&, col&, i&, j&, k&

    Set wb1 = Workbooks("7331144.xlsx")
    Set wb2 = Workbooks("5380969.xlsx")
    arr1 = wb1.Sheets(1).Range("A1").CurrentRegion.Value

    col = wb1.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
    lr = wb1.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
    With CreateObject("Scripting.Dictionary")
        For i = 2 To lr
            ReDim arr(1 To lr)
            For j = 1 To col
                arr(i) = arr(i) & arr1(i, j) & "|"
            Next
            .Item(arr(i)) = 0
        Next
        arr1 = wb2.Sheets(1).Range("A1").CurrentRegion.Value
        lr = wb2.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
        ReDim arrEnd(1 To lr, 1 To col)
        k = k + 1
        For j = 1 To col
            arrEnd(k, j) = arr1(1, j)
        Next
        For i = 2 To lr
            ReDim arr(1 To lr)
            For j = 1 To col
                arr(i) = arr(i) & arr1(i, j) & "|"
            Next
            If .exists(arr(i)) Then
            Else
                k = k + 1
                For j = 1 To col
                    arrEnd(k, j) = arr1(i, j)
                Next
            End If
        Next
    End With
    Set wb1 = Workbooks.Add(xlWBATWorksheet)
    wb1.Sheets(1).Range("A1").Resize(k, UBound(arrEnd, 2)).Value = arrEnd
End Sub