Agregar línea de dirección a macro ya creada
No entiendo que paso cuando te envíe la solicitud anterior que la tomo otra persona la cual no pudo ayudarme.
Necesito colocarle la dirección (D:\AMIGUITOS DE JESÚS|DATOS GENERALES DEL ESTUDIANTE\) a la sigute macro, La coloque donde entiendo que va pero esta dando un error en la línea que sigue más abajo.
Sub consolidando() 'x Elsamatilde 'se recorre la hoja1 del libro activo (Relación) buscando coincidencias con 'hoja Activos del libro 'Datos generales'. Sheets("Hoja1").Select Application.ScreenUpdating = False Dim lib1 As String, lib2 As String lib1 = ActiveWorkbook.Name 'se evalúa si el 2do libro está abierto sino se lo abre For Each wb In Workbooks If wb.Name = "DATOS GENERALES DEL ESTUDIANTE.xls" Then lib2 = wb.Name Exit For End If Next wb If lib2 = "" Then 'se considera que el 2do libro se encuentra en la misma carpeta....ajustar ruta = ThisWorkbook.Path & "/" Workbooks.Open ruta & "DATOS GENERALES DEL ESTUDIANTE.xls" 'se guarda el nombre para acceder lib2 = ActiveWorkbook.Name 'vuelvo al libro RELACION Workbooks(lib1).Activate ActiveWorkbook.Sheets("Hoja1").Select End If 'se definen libro/hoja para trabajar Set lb1 = ActiveWorkbook.Sheets("Hoja2") Set lb2 = Workbooks(lib2).Sheets("ACTIVOS") '1er fila destino a partir de la última registrada filx = lb1.Range("A" & Rows.Count).End(xlUp).Row + 1 'ultima fila de hoja DATOS a la que se le quitan el filtrado fini = lb2.Range("A" & Rows.Count).End(xlUp).Row If lb2.FilterMode = True Then lb2.ShowAllData 'recorre la col H en busca de celdas no vacías, hasta encontrar celda vacía en col A [H10].Select While Range("A" & ActiveCell.Row) <> "" If ActiveCell <> "" Then 'busca la matrícula en libro 2 dato = Range("A" & ActiveCell.Row) Set busco = lb2.Range("A8:A" & fini).Find(dato, LookIn:=xlValues, lookat:=xlWhole) If busco Is Nothing Then GoTo sigo 'lo encontró... guarda la dirección y pasa los datos dire = busco.Address Do fily = busco.Row lb1.Cells(filx, 1) = lb2.Range("A" & fily) lb1.Cells(filx, 2) = lb2.Range("B" & fily) lb1.Cells(filx, 3) = lb2.Range("H" & fily) lb1.Cells(filx, 4) = lb2.Range("Q" & fily) filx = filx + 1 'busca otros registros de la misma matrícula Set busco = lb2.Range("A8:A" & fini).FindNext(busco) 'el bucle continúa mientras se encuentre coincidencias y NO sea la primer celda encontrada Loop While Not busco Is Nothing And busco.Address <> dire End If 'pasa a fila siguiente y repite el bucle sigo: ActiveCell.Offset(1, 0).Select Wend MsgBox "Fin del proceso.", , "INFORMACIÓN" End Sub
1 Respuesta
Respuesta de maximo gomez
1