Oooops: forgot a . (pediod)

'-----------------
Sub ExtractRefs()
Const sDestWSName = "Results"
Dim rSource As Range
Dim wsDest As Worksheet
Dim rDest As Range
Dim re As RegExp
Dim mMatch As MatchCollection
Dim i As Long

'Get Results worksheet
'(create if doesn't exist, clear if exists)
On Error Resume Next
Set wsDest = Worksheets(sDestWSName)
On Error GoTo 0
If wsDest Is Nothing Then
Set wsDest = Worksheets.Add
wsDest.Name = sDestWSName
Else
wsDest.UsedRange.ClearContents
End If
Set rDest = wsDest.Range("A1")

Set re = New RegExp
re.Pattern = "A\d{3,}"
re.Global = True

With Worksheets("Sheet1")
For Each rSource In .Range( _
.Range("A1"), _
.Cells(Rows.Count, "A").End(xlUp))

Set mMatch = re.Execute(rSource.Value)
For i = 0 To mMatch.Count - 1
rDest.Value = mMatch(i).Value
Set rDest = rDest.Offset(1, 0)
Next i

Next rSource
End With

End Sub
'-------------
"Ardus Petus" a écrit dans le message de news:
...
This example is based on Regular Expressions.

Alt-F11 to get VBE
ToolsReferences
Tick Microsoft VBScript Regular Expressions 1.0

HTH
--
AP

'-----------------------------------
Sub ExtractRefs()
Const sDestWSName = "Results"
Dim rSource As Range
Dim wsDest As Worksheet
Dim rDest As Range
Dim re As RegExp
Dim mMatch As MatchCollection
Dim i As Long

'Get Results worksheet
'(create if doesn't exist, clear if exists)
On Error Resume Next
Set wsDest = Worksheets(sDestWSName)
On Error GoTo 0
If wsDest Is Nothing Then
Set wsDest = Worksheets.Add
wsDest.Name = sDestWSName
Else
wsDest.UsedRange.ClearContents
End If
Set rDest = wsDest.Range("A1")

Set re = New RegExp
re.Pattern = "A\d{3,}"
re.Global = True

With Worksheets("Sheet1")
For Each rSource In Range( _
.Range("A1"), _
.Cells(Rows.Count, "A").End(xlUp))

Set mMatch = re.Execute(rSource.Value)
For i = 0 To mMatch.Count - 1
rDest.Value = mMatch(i).Value
Set rDest = rDest.Offset(1, 0)
Next i

Next rSource
End With

End Sub
'--------------------------

"trammy" a écrit dans le message de news:
...
In the excel file I have:

123 A5679 REF
A111 ACC
BLOCK 545 A2456
COPY Abbc23

I would like to search for string beginning with "A" and at least 3
numbers following after letter A. Then I want to copy that string to
the new cell.
For example, the first cell, the string I want is A5679
second cell, A111
third cell, A2456
forth cell, there is no string I want
because after letter A, it is not a number.

So in the new sheet, I should have
A5679
A111
A2456

Thanks a lot,

Tammy