Option Explicit
Sub Test()
Dim objRegExp As Object
Dim objMatches As Object
Dim objMatch As Object
Dim i As Long
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Global = True
objRegExp.MultiLine = True
objRegExp.IgnoreCase = True
objRegExp.Pattern = "\bIMEI:\s*(\d*)"
For i = 2 To 4
Debug.Print ">> "; Cells(i, "P").Worksheet.Name; "!"; Cells(i, "P").Address(0, 0); " <<"
Set objMatches = objRegExp.Execute(Cells(i, "P"))
For Each objMatch In objMatches
Debug.Print " * '"; objMatch.Value; "'"; Tab(25); "| Value = '"; CStr(objMatch.SubMatches(0)); "'"
Next
Next
End Sub