Macro para buscar un valor en diferentes libros

Tengo un problema con un código, su función es que de un libro (Libro 1) tome a partir de la celda A2 los valores y los busque en diferentes libros con el mismo nombre donde hay más de 1 resultado.

Ejemplo del Libro1 donde esta el macro

El problema en el código es que si cambio de celdas no me da los resultados.

Option Explicit

Sub Resumen_por_Mes()
Dim mFolder$, iFile$
Dim mCódigos, mCod

mCódigos = WorksheetFunction.Transpose(Range([a2], [a1].End(xlDown)))

With Application.FileDialog(msoFileDialogFolderPicker)
.ButtonName = "Seleccionar"
.Title = "Selección de carpeta a procesar"
.InitialFileName = ThisWorkbook.Path
.Show
If .SelectedItems.Count = 0 Then Exit Sub
mFolder = .SelectedItems.Item(1)
End With

Application.ScreenUpdating = False
iFile = Dir(mFolder & "\*.xl*")
[c1].CurrentRegion.Offset(1).Delete xlShiftUp

Do Until iFile = ""
Workbooks.Open mFolder & "\" & iFile, False, True
For Each mCod In mCódigos
Extrae_Info mCod
Next
ActiveWorkbook.Close False
iFile = Dir
Loop

Application.ScreenUpdating = True
End Sub

Private Sub Extrae_Info(mCod)
Dim C As Range, D As Range

With ActiveWorkbook.Sheets("ANVERSO")
Set C = .[b11]
Set D = .Cells(.[a1].SpecialCells(xlLastCell).Row, "b")
Do
Set C = .Range(C, D).Find(mCod, , , xlWhole, , xlNext)
If C Is Nothing Then Exit Do
s01:
With Cells(Rows.Count, "c").End(xlUp).Offset(1)
.Resize(, 7) = Array(ActiveWorkbook.FullName, _
C, C.Offset(, 8), C.Offset(, 9), C.Offset(, 10), C.Offset(, 11))
End With
Set C = C.Offset(1): If C = mCod Then GoTo s01
Loop
End With
End Sub

Añade tu respuesta

Haz clic para o