codigo vba de comparação

boa tarde pessoal estou com este codigo VBA do Access, porem como ele esta lendo os dados das planilhas em excel, ele demora para fazer a comparação, como faço para quando eu gerar , antes ele pegue as planilhas em excel e façam virar uma banco de dados para depois comparar as planilhas e retornar com os valores em uma planilha excel novamente como ele tem feito, quero fazer isto para que ele consiga gerar os resultados mais rapidos o que ele faz neste codigo é o seguinte pega os dados da PL2 linha por linha e compara com a PL1, depois que acha todos os numeros correspondentes ele gera um arquivo do excel com os resultados, ele faz isso linha por linha, e a cada linha da PL2 ele gera um novo arquivo.  

Sub CompararPlanilhasExcel()

   Dim connPL1 As Object
   Dim connPL2 As Object
   Dim rsPL1 As Object
   Dim rsPL2 As Object
   Dim strSQLPL1 As String
   Dim strSQLPL2 As String
   Dim xlApp As Object
   Dim xlBook As Object
   Dim xlSheet As Object
   Dim i As Integer
   Dim j As Integer
   Dim k As Integer
   Dim matchEncontrado As Boolean
   Dim linhaExcel As Integer
   Dim valorPL2 As Variant
   
   ' Caminho dos arquivos Excel
   Dim caminhoPL1 As String
   Dim caminhoPL2 As String
   caminhoPL1 = "C:\Users\USER\Desktop\compara e cria\Dados Excel\PL1.xlsx" ' Ajuste o caminho para o seu arquivo PL1
   caminhoPL2 = "C:\Users\USER\Desktop\compara e cria\Dados Excel\PL2.xlsx" ' Ajuste o caminho para o seu arquivo PL2
   
   ' Configurar a conexão com o Excel usando ADO para PL1
   Set connPL1 = CreateObject("ADODB.Connection")
   
   If InStr(1, caminhoPL1, ".xlsx") > 0 Then
       ' Conexão para arquivos .xlsx
       connPL1.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & caminhoPL1 & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
   End If
   
   ' SQL para pegar os dados da planilha PL1
   strSQLPL1 = "SELECT * FROM [Plan1$]"
   
   ' Abrir o recordset da PL1
   Set rsPL1 = CreateObject("ADODB.Recordset")
   rsPL1.Open strSQLPL1, connPL1, 1, 3
   
   ' Configurar a conexão com o Excel usando ADO para PL2
   Set connPL2 = CreateObject("ADODB.Connection")
   
   If InStr(1, caminhoPL2, ".xlsx") > 0 Then
       connPL2.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & caminhoPL2 & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
   End If
   
   ' SQL para pegar os dados da planilha PL2
   strSQLPL2 = "SELECT * FROM [Plan1$]" ' Certifique-se de que o nome da aba é "Plan1$"
   
   ' Abrir o recordset da PL2
   Set rsPL2 = CreateObject("ADODB.Recordset")
   rsPL2.Open strSQLPL2, connPL2, 1, 3
   
   ' Inicializar o Excel para exportar os resultados
   Set xlApp = CreateObject("Excel.Application")
   xlApp.Visible = False
   
   ' Percorrer cada linha da PL2
   Do Until rsPL2.EOF
       ' Criar um novo arquivo do Excel para cada linha da PL2
       Set xlBook = xlApp.Workbooks.Add
       Set xlSheet = xlBook.Sheets(1)
       linhaExcel = 1
       
       ' Percorrer cada linha da PL1
       rsPL1.MoveFirst ' Resetar PL1 para a primeira linha
       Do Until rsPL1.EOF
           matchEncontrado = True
           
           ' Percorrer os valores da linha da PL2
           For k = 0 To rsPL2.Fields.Count - 1
               valorPL2 = rsPL2.Fields(k).Value
               ' Verificar se o valor da PL2 está presente em alguma coluna da linha da PL1
               matchEncontrado = False
               For i = 0 To 14 ' PL1 tem 15 colunas (0 a 14)
                   If rsPL1.Fields(i).Value = valorPL2 Then
                       matchEncontrado = True
                       Exit For
                   End If
               Next i
               If Not matchEncontrado Then Exit For
           Next k
           
           ' Se houver correspondência, adicionar a linha da PL1 ao arquivo Excel
           If matchEncontrado Then
               For j = 0 To 14
                   xlSheet.Cells(linhaExcel, j + 1).Value = rsPL1.Fields(j).Value
               Next j
               linhaExcel = linhaExcel + 1
           End If
           
           rsPL1.MoveNext
       Loop
       
       ' Salvar o arquivo Excel com nome específico para a linha da PL2
       If linhaExcel > 1 Then
           xlBook.SaveAs CurrentProject.Path & "\Resultado_Comparacao_Linha_" & rsPL2.AbsolutePosition + 1 & ".xlsx"
       End If
       
       xlBook.Close False
       rsPL2.MoveNext
   Loop
   
   ' Fechar o Excel
   xlApp.Quit
   
   ' Limpar os objetos
   Set xlSheet = Nothing
   Set xlBook = Nothing
   Set xlApp = Nothing
   rsPL1.Close
   rsPL2.Close
   Set rsPL1 = Nothing
   Set rsPL2 = Nothing
   connPL1.Close
   connPL2.Close
   Set connPL1 = Nothing
   Set connPL2 = Nothing
   
   MsgBox "Comparação concluída e arquivos Excel salvos.", vbInformation

End Sub

se alguem puder dar uma ideia agradeço

Para o código ficar mais eficiente você tem que utilizar uma abordagem que faça o menor número possível de interações com a planilha. Sugiro você utilizar array para armazenar os valores a serem comparados. Assim, ao fazer o loop, você o faz na memória e não diretamente no objeto, tornando a execução muito mais rápida.

Boa noite e bem-vindo ao fórum
Movi-lhe a dúvida para esta sala por se tratar de Excel.