tomar rango en excel

[lokoman]

Puedes usar una sentencia SQL en un recordset:
"SELECT * FROM [HOJA$] WHERE [NOMBRE_COLUMNA]=" & 1

eso te cargaria todos los registros que sean "1", a partir de ahi lo copias en otro archivo excel, este seria el proceso:

1-Conectarse al archivo de excel
2-Leer los registros que sean "1"
3-Copiar los registros que sean "1" en un archivo excel nuevo

ejem.:

Código vb:

'PARA OBTENER EL NOMBRE DE LA  HOJA ACTIVA
                Dim ObjExcel As Object
                Set ObjExcel = CreateObject("Excel.Application")
                
                'Abre los libros
                ObjExcel.Workbooks.Open "RUTA DEL ARCHIVO DE EXCEL"
                
                With ObjExcel
                    .ActiveSheet.Select ' La selecciona
                    NombreHoja = UCase(.ActiveSheet.Name)
                End With
                
                'Descarga la referencia y cierra el Excel
                ObjExcel.Quit
                Set ObjExcel = Nothing
                
                DoEvents
                        
'CONEXION A LOS ARCHIVOS EXCEL
               Dim Conn As ADODB.Connection
               Dim Rec As New ADODB.Recordset
 
                Set Conn = New ADODB.Connection
                
                With Conn
                    .Provider = "MSDASQL"
                    .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
                    "DBQ=" & Trim(RUTA DEL ARCHIVO DE EXCEL) & "; ReadOnly=False;"
                    Conn.Open
                End With
 
                Rec.Source = "SELECT * FROM [" & Trim(NombreHoja) & "$] WHERE [COLUMNA]=" & 1
                Rec.Open , Conn, adOpenForwardOnly, adLockReadOnly
        
                If Not Rec.EOF Then
                        Dim xlApp As Excel.Application
                        Dim xlBook As Excel.Workbook
                        Dim xlSheet As Excel.Worksheet
                        Dim CellCnt As Double
                        Dim I, J As Double
 
    
                        Set xlApp = New Excel.Application 'asignar las referencias a las variables
                        Set xlBook = xlApp.Workbooks.Add
                        Set xlSheet = xlBook.Worksheets.Add
    
                        I = 2      
                        CellCnt = 1 
 
                        DO WHILE REC.EOF=FALSE
                             xlSheet.Cells(I, CellCnt) = REC!COLUMNA
                             I = I + 1
                            DOEVENTS
                        LOOP
 
'Ajustar todas las columnas
                        For J = 1 To lsvData.ColumnHeaders.Count
                            xlSheet.Columns(J).AutoFit
                        Next J
 
'Salvar la hoja de excel
                        xlSheet.Name = "EXPORT"
                        xlSheet.SaveAs "EXPORT.XLS"
                        MsgBox "Consulta exportada a Excel!!", vbInformation
 
                        xlBook.Close
                        if rec.state=1 then rec.close
                        xlApp.Quit
                        Set xlApp = Nothing
                        Set xlBook = Nothing
                        Set xlSheet = Nothing
                        Set rec=nothing
                    End if
 

Ajusta el code