Option Explicit

Sub teste()
    
    Dim ano As Integer
    
    ano = 2018
    Dim soma As Double
    soma = 0
    Dim sh As Worksheet
    Dim linha As Long
    For Each sh In ThisWorkbook.Sheets
        If UCase(sh.Name) <> UCase("Menu") Then
            linha = 2

            While Sheets(sh.Name).Range("A" & linha).Value <> ""
                
                If Year(CDate(Sheets(sh.Name).Range("A" & linha).Value)) = ano Then
                    
                    soma = soma + CDbl(Sheets(sh.Name).Range("B" & linha).Value)
                    
                End If
                linha = linha + 1
            Wend
            
        End If
        
    Next sh
    
    MsgBox soma
    
End Sub

Em seu codigo como está; a soma e "fracionada" por

mes independentemente do ano --> If Mid(Cells(a, "A"), 4, 2) = Mes Then e

ano --> If Mid(Cells(a, "A"), 7, 4) = Ano
Se seu objetivo e somar mês de acordo com o ano indicado experimente:

With ThisWorkbook.Sheets("FARMACIA")
    .Activate
    For a = 2 To .UsedRange.Rows.Count
        Cells(a, "A").Select
        If Cells(a, "A") <> "" Then
            If Format(Month(Cells(a, "A")), "00") = Mes And Year(Cells(a, "A")) = Ano Then
                somaFarmaciaMes = somaFarmaciaMes + CDbl(Format(Cells(a, "B"), "currency"))
            End If
        End If
    Next
End With

Option Explicit



Sub teste()
    
    Dim ano As Integer
    Dim mes As Integer
    ano = 2018
    mes = 2
    Dim soma As Double
    soma = 0
    Dim sh As Worksheet
    Dim linha As Long
    For Each sh In ThisWorkbook.Sheets
        If UCase(sh.Name) <> UCase("Menu") Then
            linha = 2
            
            While Sheets(sh.Name).Range("A" & linha).Value <> ""
                
                If Year(CDate(Sheets(sh.Name).Range("A" & linha).Value)) = ano Then
                    If Month(CDate(Sheets(sh.Name).Range("A" & linha).Value)) = mes Then
                        
                        soma = soma + CDbl(Sheets(sh.Name).Range("B" & linha).Value)
                    End If
                End If
                linha = linha + 1
            Wend
            
        End If
        
    Next sh
    
    MsgBox soma
    
End Sub

Cinco dicas que foram muito úteis para mim:

1) Quando não sei fazer algo no VBA, vou ao menu EXIBIÇÃO >> MACROS >> GRAVAR MACRO
Faço o que eu quero aí volto ao menu EXIBIÇÃO >> MACROS >> PARAR GRAVAÇÃO
Aperto Alt + F11 e vejo como a macro fez aqui. Tento entender e tento adaptar.

2) Quando vou criar um código e o resultado não está saindo como o esperado, entro no código e vou apertando F8 para executar passo a passo, aí vou passando o mouse sobre as variáveis para verificar se o valores delas estão corretos, já consertei milhares de códigos dessa forma.

3) Antes de executar o código, vou ao menu Depurar >> Compilar. Isso ajuda corrigir erros mais simples, como o nome de uma variável digitado errado.

4) Declaro todas as variáveis. Isso também evita erros.

5) Sempre uso o Option Explicit lá no início. Ele me obriga a declarar as variáveis.