@jalmeida

Não entendi a questão da soma, porém pras demais necessidades esses ajustes resolvem:

Option Explicit
Sub ProjetoAlpha()
  Dim WkbOrigem As Workbook, WkbDestino As Workbook
  Dim Pasta As String, Arquivo As String, parceiro As String
  Dim linha As Long

  Set WkbDestino = ThisWorkbook
  
  Pasta = ThisWorkbook.Path & "\Relatorios\"
  
  linha = 7
  Do While WkbDestino.Sheets(1).Cells(linha, 2) <> ""
  
        parceiro = WkbDestino.Sheets(1).Cells(linha, 2)
        Arquivo = Dir(Pasta)
        
        Do Until Arquivo = ""
        
          If Left(Arquivo, 6) = parceiro Then
        
                Set WkbOrigem = Workbooks.Open(Pasta & Arquivo)
                WkbDestino.Activate
                    
                WkbDestino.Sheets(1).Cells(linha, 3).Value = WkbOrigem.Sheets(1).Range("B1").Value 'Dados Origem
                WkbDestino.Sheets(1).Cells(linha, 4).Value = WkbOrigem.Sheets(1).Range("B3").Value 'Empresa
                WkbDestino.Sheets(1).Cells(linha, 5).Value = WkbOrigem.Sheets(1).Range("D3").Value 'Endereço
                WkbDestino.Sheets(1).Cells(linha, 6).Value = WkbOrigem.Sheets(1).Range("D1").Value 'Codigo Origem
                WkbDestino.Sheets(1).Cells(linha, 7).Value = WkbOrigem.Sheets(1).Range("F1").Value 'Setor
                
                WkbOrigem.Close False
                Exit Do
          
          End If
          
          Arquivo = Dir()
          
        Loop
  
  linha = linha + 1
  Loop

End Sub

@raygsson
Boa noite, com vai, tudo bem?
Gostaria de agradecer pelo retorno e contribuição, o que foi fundamental para a solução do meu problema.
A questão da soma era para efetuar os cálculos de acordo com os intervalos informados, o que já consegui resolver.
Muito obrigado pelo apoio!