Talvez seja interessante adicionar o campo Status à tabela, como é feito neste vídeo a partir de 1h06min:

https://youtu.be/CTq_aV6XSwU

 shRec.Range("A" & shRec.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row).CopyFromRecordset rsConsulta

Na linha de conexão declarar o caminho completo da sua planilha com o "FullName" fica melhor também, se renomear não vai precisar ficar alterando o nome no código, mas é apenas detalhe.

 ConexaoPlan.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source =" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0;"

Anderson, Raygsson, boa noite!

Muito obrigado pela ajuda! Fiz uma adaptação para outro arquivo mas agora está dando um erro em tempo de execução (nenhum valor foi fornecido para um ou mais parâmetros ...)

Poderiam me ajudar a identificar esse erro? Estou anexando o arquivo com a sql.

Obrigado!

@anderson

Fiz de acordo com suas orientações e deu super certo! Muito obrigado!

Entretanto, ao adaptar ao arquivo original, com fórmulas nomeadas (o que necessariamente precisa ter por questões de atualização financeira), na hora de atualizar o aba histórico os campos perdem o formato. Tentei várias ações mas não deu certo. Se importa em tentar me ajudar nesse sentido? Estou anexando os arquivos para demonstração/testes.

@anderson

Boa tarde, tudo bem? Primeiramente, feliz Ano Novo, com muita saúde e paz!!

Perfeita sua solução, entretanto, ao adaptar o código tive um problema de delay, considerando a função de conversão CDbl tendo o início na linha 3 com a estrutura While. O relatório de Histórico tem mais de 10.000 linhas e essa atualização fica muito, muito demorada.

Se ao invés de convertermos os dados da aba Histórico (após a cópia), antes deletássemos as linhas da aba Controle, cujo campo Data_Pagamento esteja vazio, via SQL, não seria mais rápida a atualização sem a necessidade de conversão?

Pensei algo assim (Via SQL): Primeiro deletaríamos as linhas do campo Data_Pagamento (Sem dados), aba Controle, depois usaríamos o copyfromrecordset para despejar os dados (com datas) na aba Histórico. O que acha, seria possível?

Grato pelo apoio.

Sub AtualizaDados()
Call TurnOffStuff

Dim Arquivo As Variant
Arquivo = Application.GetOpenFilename("Abrir Arquivo, *.xls")
Workbooks.Open Arquivo

Set Arquivo = ActiveSheet
With Arquivo
.Rows("1:7").EntireRow.Delete
.Columns("A").Replace what:="1", Replacement:="Zona Sul"
.Columns("A").Replace what:="3", Replacement:="Superdelli"
.Columns("B").Replace what:="-", Replacement:=""
.Columns("E").Insert
.Columns("J").Cut Columns("E")
End With

Windows("Relat_Faturamento_IV").Activate
shControle.ListObjects("Tab_Base").AutoFilter.ShowAllData
shControle.ListObjects("Tab_Base").DataBodyRange.Delete

Arquivo.Range("A1").CurrentRegion.Copy
Range("A3").PasteSpecial Paste:=xlPasteValues

Arquivo.Activate
ActiveWorkbook.Close SaveChanges:=False

MsgBox "Dados Atualizados com Sucesso!", vbOKOnly, "Departamento de Contas a Pagar"
[A4].Select
Call TurnOnStuff
End Sub
Sub AtualizaHistorico()
application.screenupdating = false
Call TurnOffStuff
Dim ConexaoPlan As New ADODB.Connection
Dim rsConsulta As New ADODB.Recordset
Dim Sql As String
Dim linha As Long
linha = shHistorico.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ConexaoPlan.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source =" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0;"
ConexaoPlan.Open

Sql = "Select * From [Controle$] Where IsNull(Data_Pagamento) = False"
rsConsulta.Open Sql, ConexaoPlan, adOpenKeyset, adLockOptimistic

shHistorico.Range("A" & shHistorico.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row).CopyFromRecordset rsConsulta

rsConsulta.Close
ConexaoPlan.Close




While shHistorico.Range("P" & linha).Value <> ""

shHistorico.Range("P" & linha).Value = CInt(shHistorico.Range("P" & linha).Value)
shHistorico.Range("W" & linha).Value = CInt(shHistorico.Range("W" & linha).Value)
shHistorico.Range("Y" & linha).Value = CInt(shHistorico.Range("Y" & linha).Value)

shHistorico.Range("R" & linha).Value = CDbl(shHistorico.Range("R" & linha).Value)
shHistorico.Range("S" & linha).Value = CDbl(shHistorico.Range("S" & linha).Value)
shHistorico.Range("V" & linha).Value = CDbl(shHistorico.Range("V" & linha).Value)
shHistorico.Range("T" & linha).Value = CDbl(shHistorico.Range("T" & linha).Value)
shHistorico.Range("U" & linha).Value = CDbl(shHistorico.Range("U" & linha).Value)

linha = linha + 1


Wend

shHistorico.Select
shHistorico.Range("T:T,U:U").Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"

MsgBox "Dados atualizados com sucesso!", vbOKOnly
[A2].Select
Call TurnOnStuff
application.screenupdating = true
End Sub

Já tem um comando pra excluir as datas vazias no SQL "IsNull(Data_Pagamento) = False"

Pra otimizar a atualização + formatação do histórico eu colocaria um loop de formatação direto num loop pra descarregar o RecordSet.

É mais rápido que um loop normal linha a linha da planilha. Fiz o teste aqui e demorou 1 segundo pra atualizar + formatar.

Sub AtualizaHistorico()
Call TurnOffStuff
Dim ConexaoPlan As New ADODB.Connection
Dim rsConsulta As New ADODB.Recordset
Dim Sql As String, i As Double
Dim tempo As Variant

tempo = Now

ConexaoPlan.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source =" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0;"
ConexaoPlan.Open

Sql = "Select * From [Controle$] Where IsNull(Data_Pagamento) = False"
rsConsulta.Open Sql, ConexaoPlan, adOpenKeyset, adLockOptimistic

i = shHistorico.Cells(Rows.Count, 1).End(xlUp).Row + 1
Do While Not rsConsulta.EOF
   shHistorico.Cells(i, 1) = rsConsulta(0)
   shHistorico.Cells(i, 2) = rsConsulta(1)
   shHistorico.Cells(i, 3) = rsConsulta(2)
   shHistorico.Cells(i, 4) = rsConsulta(3)
   shHistorico.Cells(i, 5) = rsConsulta(4)
   shHistorico.Cells(i, 6) = rsConsulta(5)
   shHistorico.Cells(i, 7) = rsConsulta(6)
   shHistorico.Cells(i, 8) = rsConsulta(7)
   shHistorico.Cells(i, 9) = rsConsulta(8)
   shHistorico.Cells(i, 10) = rsConsulta(9)
   shHistorico.Cells(i, 11) = rsConsulta(10)
   shHistorico.Cells(i, 12) = rsConsulta(11)
   shHistorico.Cells(i, 13) = rsConsulta(12)
   shHistorico.Cells(i, 14) = rsConsulta(13)
   shHistorico.Cells(i, 15) = rsConsulta(14)
   shHistorico.Cells(i, 16) = CInt(rsConsulta(15))
   shHistorico.Cells(i, 17) = rsConsulta(16)
   shHistorico.Cells(i, 18) = CDbl(rsConsulta(17))
   shHistorico.Cells(i, 19) = CDbl(rsConsulta(18))
   shHistorico.Cells(i, 20) = CDbl(rsConsulta(19))
   shHistorico.Cells(i, 21) = CDbl(rsConsulta(20))
   shHistorico.Cells(i, 22) = CDbl(rsConsulta(21))
   shHistorico.Cells(i, 23) = CInt(rsConsulta(22))
   shHistorico.Cells(i, 24) = rsConsulta(23)
   shHistorico.Cells(i, 25) = CInt(rsConsulta(24))
i = i + 1
rsConsulta.MoveNext
Loop

shHistorico.Range("T:T,U:U").Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.0%"

rsConsulta.Close
ConexaoPlan.Close

MsgBox "Dados atualizados com sucesso em " & Format(Now - tempo, "HH:MM:SS"), vbInformation, "Aviso."
[A2].Select
Call TurnOnStuff
End Sub

@raygsson

Muito obrigado pela ajuda! Deu certo!

@anderson

Muito obrigado pela ajuda. Deu certo!