Option Explicit
Sub test()
Dim StringOne As String
Dim StringTwo As String
Dim FileName As Variant
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim wksDest As Worksheet
Dim UserRange As Range
Dim Cell As Range
Dim i As Long
Dim n As Long
Dim m As Long
Dim k As Long
Dim j As Long
Dim Cellnum As Long
Dim z As Integer
Cellnum = InputBox("Ingresar numero de filas a buscar")
Set UserRange = Application.Selection
Set wksDest = ActiveWorkbook.ActiveSheet
'//Change the file extension for the file filter, accordingly
FileName = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xlsx), *.xlsx", _
FilterIndex:=1, _
Title:="Seleccione el libro en el que se buscara")
If FileName = False Then Exit Sub
Application.ScreenUpdating = False
Set wkbSource = Workbooks.Open(FileName:=FileName)
Set wksSource = wkbSource.Worksheets(1)
For m = 1 To Cellnum 'Cambiar este valor al numero de filas en hoja2***********
wksSource.Cells(m, "A").NumberFormat = "General"
Next m
'lol
For Each Cell In UserRange
'
If IsEmpty(wksDest.Cells(Cell.Row, "A").Value) = False Then
'
wksDest.Cells(Cell.Row, "A").NumberFormat = "General"
For i = 1 To Cellnum 'Cambiar este valor al numero de filas en hoja2***********
If wksSource.Cells(i, "A").Value = wksDest.Cells(Cell.Row, "A").Value Then
'MsgBox "hey"
j = 1
Do Until j = 0
If wksSource.Cells(i, "A").Offset(-j, 0).Value = "Análisis:" Then
StringOne = wksDest.Cells(Cell.Row, "C").Value
StringTwo = wksSource.Cells(i, "A").Offset(-j, 1).Value
If IsEmpty(wksDest.Cells(Cell.Row, "C").Value) = True Then
wksDest.Cells(Cell.Row, "C").Value = StringTwo
Else
wksDest.Cells(Cell.Row, "C").Value = StringOne & ", " & StringTwo
End If
j = 0
Else
j = j + 1
End If
Loop
End If
Next i
'
End If
'
Next Cell
'lol
'wkbSource.Close Savechanges:=False
Application.ScreenUpdating = True
End Sub