Macro para Extraer información de otro Archivo II
A los miembros de este foro, hace mucho tiempo me ayudaron con esta macro que consiste en como extraer información de un archivo cerrado y la cual me sigue ayudando mucho, ahora quiero que me brinde su apoyo bajo la misma primicia que extraiga el siguiente valor que se encuentra resaltado de color amarillo, y deben ser agregados en el archivo PLANILLA000.xlsm en la Columna L filas 4 - 20 - 36 - 52 - 68 - 84 - 100 - 116 - 132 - 148
getClosedWbData.bas
Sub CODIGOS() ' procedimiento para obtener datos de un libro cerrado segun condiciones ' _ R&D: Héctor Miguel Orozco Díaz | mayo de 2016 ' Dim ruta As String, archivo As String, hoja As String, pas As String, _ conexion As Object, registros As Object, celda As Range ruta = ThisWorkbook.Path & "\" ' <= carpeta donde se encuentra el... ' 'archivo = "sort.xlsm" ' archivo del que se rescatan los codigos en ... ' archivo = "sort estiba.xlsm" ' archivo del que se rescatan los codigos en ... ' hoja = "ingreso" ' la hoja que los contiene ' pass = "A" ' <= la contraseña para (des/re)proteger la hoja ' ActiveSheet.Unprotect pass Set conexion = CreateObject("adodb.connection") Set registros = CreateObject("adodb.recordset") conexion.Open "provider=microsoft.ace.oledb.12.0;data source=" & ruta & archivo & _ ";extended properties=""excel 12.0 xml;imex=1;hdr=yes"";" For Each celda In Range([a1], Cells(Rows.Count, 1).End(xlUp)).SpecialCells(2, 2) If celda = "COD" Then celda.Offset(, 10) = "" registros.Open "select grupo from [" & hoja & "$] where cod = """ & celda.Offset(, 1) & """", conexion, 1, 1 If registros.RecordCount > 0 Then _ celda.Offset(, 10) = Join(Application.Transpose(Application.Transpose(registros.GetRows)), "; ") registros.Close End If: Next: ActiveSheet.Protect pass: Set registros = Nothing: conexion.Close: Set conexion = Nothing: MsgBox ("Extracción Terminado"), , "AVISO": End Sub