Fusionar 2 codigos

Hola q tal tengo un problema necesito hacer un buscador en excel pero q me busque datos en todos los libros q existan en una carpeta seleccionada pero q me muestre en q libro hoja y celda se encuentra y tengo 2 codigo uno q hice y otro q me proporcionaron pero quiero fusionarlos para q sea uno solo
Sub BuscarEnLibrosAbiertos()
Dim Libro As Workbook, Hj As Worksheet
Dim C As Range, FirstCell As String
Range("a2:f" & [c65536].End(xlUp).Offset(10).Row).Delete xlShiftUp
Application.ScreenUpdating = False
For Each Libro In Application.Workbooks
  If Libro.Name <> ThisWorkbook.Name Then
  For Each Hj In Libro.Worksheets
    Set C = Hj.Cells.Find(What:=[f1], LookIn:=xlValues, LookAt:=xlPart)
    If C Is Nothing Then GoTo ProximaHoja
    FirstCell = C.Address
    Do
      With [a65536].End(xlUp).Offset(1).Resize(1, 3)
        .Cells = Array(Libro.Name, Hj.Name, C.Address)
        ActiveSheet.Hyperlinks.Add Anchor:=.Cells, Address:="", SubAddress:=C.Address(External:=True)
      End With
      Set C = Hj.Cells.FindNext(C)
    Loop Until FirstCell = C.Address
ProximaHoja:
  Next Hj
  End If
Next Libro
Set C = Nothing
Range("a2:c" & [c65536].End(xlUp).Offset(10).Row).Font.Size = 12
[a:f].Columns.AutoFit
Application.ScreenUpdating = True
End Sub
Private Sub Botón2_AlHacerClic()
    Dim fso As Scripting.FileSystemObject
    Dim Folder As Folder
    Dim Files As Files
    Dim File As File
    Dim Extension As String
    Dim Arch_Excel As String
    Set fso = New Scripting.FileSystemObject
    Set Folder = fso.GetFolder("C:\Documents and Settings\israel.perezs\Mis documentos\progra\Ejemplos")
    Set Files = Folder.Files
    For Each File In Files
        Extension = Mid$(File, Len(File) - 3, 4)
        If Extension = ".xls" Or Extension = ".xlsx" Then
            'Arch_Excel = File
            'MsgBox Arch_Excel
        End If
    Next
    Set fso = Nothing
    Set Folder = Nothing
    Set Files = Nothing
    Set File = Nothing
    'Dim Excel As Excel.Application
    'Set Excel = New Excel.Application
    'Excel.Workbooks.Open ("C:\Documents and Settings\israel.perezs\Mis documentos\progra\Ejemplos\lista.xls")
    'Excel.Visible = True
End Sub
o si me puedes proporcionaar otra manera de hacerlo te estare muy agradecido

1 Respuesta

Respuesta
1
Bueno para que puedas fusionar el codigo tendrias que modificar el codigo Private Sub Botón2_AlHacerClic para que ahi vayas buscando la informacion incluyendo en el for each la apertura del archivoy la llamada a la funcion de buscar al aterminar cerrar el archivo que abriste
yo se q a lo mejor es mucho pedir pero me podrias mostras como ya q no tengo ni idea de como hacerlo
Algo asi no tuve tiempo de probarlo pero es la idea
Private Sub Botón2_AlHacerClic()
    Dim fso As Scripting.FileSystemObject
    Dim Folder As Folder
    Dim Files As Files
    Dim File As File
    Dim Extension As String
    Dim Arch_Excel As String
   'Dim Excel As Excel.Application
   'Set Excel = New Excel.Application  
    Set fso = New Scripting.FileSystemObject
    Set Folder = fso.GetFolder("C:\Documents and Settings\israel.perezs\Mis documentos\progra\Ejemplos")
    Set Files = Folder.Files
    For Each File In Files
        Extension = Mid$(File, Len(File) - 3, 4)
        If Extension = ".xls" Or Extension = ".xlsx" Then
             Excel.Workbooks.Open Arch_excel
            call BuscarEnLibrosAbiertos()
             excel.Workbooks.close
                 'Arch_Excel = File
            'MsgBox Arch_Excel
        End If
    Next
    Set fso = Nothing
    Set Folder = Nothing
    Set Files = Nothing
    Set File = Nothing
    'Excel.Workbooks.Open ("C:\Documents and Settings\israel.perezs\Mis documentos\progra\Ejemplos\lista.xls")
    'Excel.Visible = True
End Sub
hasta el momento casi perfecto solo un pequeño defecto q cuando se manda a cerrar el libro q se abrio con excel.workbooks.close el programa cierra hasta el libro en el cual funciona la macro
como hacerle para q eso no suceda
Cambialo por activeworkbook. Close asi solo cerrara el libro activo

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas