Excel - Registros duplicados

Option Explicit

'//By JuanC - May. 2017

'//Use reference: Microsoft ActiveX Data Objects 2.0 Library

Public Sub lot_rep_comp()

Dim con As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim rs2 As New ADODB.Recordset

Dim sSql$

con.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _

         "Data Source=" & ActiveWorkbook.FullName & ";" & _

         "Extended Properties=Excel 12.0"

sSql = "SELECT a.programa, a.fecha, a.id_lote, a.pares, a.id_estilo, a.id_corrida, a.corrida, a.id_com, a.combi, a.almacen, a.semana, a.año, a.mes " & _

       "FROM [Hoja1$] AS a " & _

       "INNER JOIN (SELECT id_lote, COUNT(*) AS total " & _

                   "FROM [Hoja1$] " & _

                   "GROUP BY id_lote " & _

                   "HAVING COUNT(*)>1) AS b " & _

       "ON (a.id_lote=b.id_lote) " & _

       "ORDER BY a.id_lote"

rs.Open sSql, con, adOpenStatic

Hoja4.Cells.Clear

Hoja4.Range("B2").CopyFromRecordset rs

rs.Close

con.Close

Set rs = Nothing

Set rs2 = Nothing

Set con = Nothing

End Sub