Nao estou conseguindo postar a planilha aqui, mas olha postei ele no onedrive
https://1drv.ms/u/s!Al6bC5FwGaP7ghcFV0TWE4zdAuLc (está em .rar e não é virus pode confiar)
caso queira também, estou deixando o codigo abaixo, e a planilha teste2.xlsx contem os dados que estou comparando, ok?agradeço pela força amigo
Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Global banco As Database
Global consulta As Dao.Recordset
Sub Comando0_Click()
Dim objXLApp As New Excel.Application
Dim ComandoSQL As String
Dim linha As String
Dim oApp As Object
Dim objXLSheet As Excel.Worksheet
Dim objXLBook As Excel.Workbook
'Se atribuir True, a janela do Excel aparecerá
Set objXLBook = objXLApp.Workbooks.Open("C:\Users\m206519\Desktop\teste2.xlsx")
Set objXLSheet = objXLBook.Worksheets("dados")
objXLSheet.Range("A2").Select
objXLBook.Windows(1).Visible = True
'lopping das linhas
Do While objXLApp.ActiveCell <> ""
linha = objXLApp.ActiveCell.Row
Set banco = CurrentDb
'Armazena na variável o comando que fará a consulta SQL no BD Access
ComandoSQL = "select * from Tabela1"
'Atribui a variável de Objeto de BD a execução dos comandos SQL
Set consulta = banco.OpenRecordset(ComandoSQL)
With consulta
'Abre o Recordset do BD para inserção
.AddNew
.Fields("Nota APTR Liberada") = objXLApp.Sheets("dados").Cells(linha, 1) 'ID
.Fields("Empreendedor") = Sheets("dados").Cells(linha, 2) 'nome
.Fields("Nome do Empreendimento") = Sheets("dados").Cells(linha, 3) 'sobrenome
.Fields("Endereço da Obra") = Sheets("dados").Cells(linha, 4) 'cpf
.Fields("Localidade") = Sheets("dados").Cells(linha, 5)
.Fields("Grp plnj PM") = Sheets("dados").Cells(linha, 6) 'rg
.Fields("Início desejado") = Sheets("dados").Cells(linha, 7) 'endereço
.Fields("APTR Liberada Rejeitada") = Sheets("dados").Cells(linha,
'numero
.Fields("Análise de Servidão de Passagem Data") = Sheets("dados").Cells(linha, 9) 'cidade
.Fields("Solicitação de Tombamento") = Sheets("dados").Cells(linha, 10) 'UF
.Fields("Nota IS Projeto de Incorporação de Rede") = Sheets("dados").Cells(linha, 11)
.Fields("Projeto de Incorporação DDR1") = Sheets("dados").Cells(linha, 12)
.Fields("Projeto de Incorporação DDR2") = Sheets("dados").Cells(linha, 13)
.Fields("Nota INEP de Aprovação") = Sheets("dados").Cells(linha, 14)
.Fields("Nota IRDP") = Sheets("dados").Cells(linha, 15)
.Fields("Projeto de Interligação") = Sheets("dados").Cells(linha, 16)
.Fields("Processo IR") = Sheets("dados").Cells(linha, 17)
.Fields("Coordenação Responsável") = Sheets("dados").Cells(linha, 18)
.Fields("Tipo de Rede Interna - Aerea, Subterrânea ou Mista") = Sheets("dados").Cells(linha, 19)
.Fields("Energizado Em") = Sheets("dados").Cells(linha, 20)
.Fields("Orçamento ELPA Projeto PLM Aéreo") = Sheets("dados").Cells(linha, 21)
.Fields("Orçamento ELPA Projeto PLM Subterrâneo Concluído") = Sheets("dados").Cells(linha, 22)
.Fields("Servidão ou Ofício") = Sheets("dados").Cells(linha, 23)
.Fields("Notas Fiscais") = Sheets("dados").Cells(linha, 24)
.Fields("Notas projeto CM ou LN") = Sheets("dados").Cells(linha, 25)
.Fields("Status") = Sheets("dados").Cells(linha, 26)
.Fields("Contrato de incorporação") = Sheets("dados").Cells(linha, 27)
.Fields("Contrato de Obra interligação") = Sheets("dados").Cells(linha, 28)
.Fields("Encaminhado a Gestão de Ativos em") = Sheets("dados").Cells(linha, 29)
.Fields("Encaminhado a Controladoria em") = Sheets("dados").Cells(linha, 30)
'Se houver erro
On Error Resume Next
'Efetiva a atualização do BD
.Update
'Fecha o Recorset e a conexão com o BD
consulta.Close
banco.Close
'Chama a rotina que desconecta do BD (libera variáveis objeto de BD)
Call Desconecta
ActiveCell.Offset(1, 0).Select
End With
Loop
'Exibe mensagem de sucesso na inclusão do registro
MsgBox "Dados transferidos com Sucesso! ", vbDefaultButton1, "Transferência"
'Abandona a subrotina
Exit Sub
objXLBook.Save
'Fecha nova instância
objXLApp.Quit
'Quebra as referênciasSet
Set objXLSheet = Nothing
Set objXLBook = Nothing
Set objXLApp = Nothing
End Sub