Hi Steve

Thanks for the reply but I've been struggling not very good at VBA learn on
the hoof viewing this forum and others -- after text to columns the ID number
is in column C on sheet1 and the others are in D & E columns been changing
them all around in your code - however no values go into the cells against
the ID number when found on the other sheets not matter what combination I
use -- any idea's ??
--
Many Thanks

Sue


"Incidental" wrote:

Hi Sue

The code below should do what your after though it is a little messy
but it will give you an idea of a way round your problem

Option Explicit
Dim WkSh As Worksheet
Dim fCell As Range
Dim fCellAdd As String
Dim MyCell, MyRng As Range
Dim LastRow As Integer

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
'Prevent the screen flickering during update
Sheets("Sheet1").Activate
'Set the sheet that holds your search criteria
LastRow = [A65535].End(xlUp).Row
'Find the last used row in column A
Set MyRng = Range("A1:A" & LastRow)
'Set your range
For Each MyCell In MyRng
'Set a loop through the cells in the range
For Each WkSh In ThisWorkbook.Worksheets
WkSh.Activate
'Set a loop through the worksheets
If WkSh.Name = "Sheet1" Then GoTo line1
Set fCell = [A:A].Find(MyCell.Value, Lookat:=xlWhole)
'Search for the ID number
If Not fCell Is Nothing Then
'If found continue
fCellAdd = fCell.Address
'Store the cell address of the found cell
Do
fCell.End(xlToRight).Offset(0, 1).Value = MyCell.Offset(0, 1)
fCell.End(xlToRight).Offset(0, 1).Value = MyCell.Offset(0, 2)
'Set you values to the required cells
Set fCell = [A:A].FindNext(fCell)
'Check for more instances in the same sheet
Loop While Not fCell Is Nothing And fCell.Address < fCellAdd
'Check the address against the first found to prevent looping
End If
line1:
Next WkSh
Next MyCell
Application.ScreenUpdating = True
'Return the screenupdating setting to true
End Sub


hope this helps

Steve