Problem with Range and Occurrences

[Telesphore]

In Sheets(1) we have these columns: CarOwnerName, LicenceNumbers,
LicenceLetters, AmountPaid, etc..
The licence numbers have 3 letters and 3 numbers.
When a car passes in front of us we would like to identify the owner
informations.
So we enter the 3 numbers in the InputBox.
We would like to 1) copy on Sheets(2) the 5 or 6 cells of the adjacent
columns to the active cell 3 numbers found and 2) check if there are the
same 3 numbers for other clients.

Any help woul be apprecciated. Thank you.

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
Range(ActiveCell.Offset(?, ?), ActiveCell.Offset(?, ?)).Copy
Selection.Copy
Sheets(2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

 

[Guest]

This copies 7 columns, including active cell i.e. car number to next
available row, starting column A, on sheet2. Change the second number in
RESIZE to alter number of columns copied.

It counts occurences of VAR in Sheets(1) and produces a message if count > 1.

HTH

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
With Sheets(1)
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)
Cells.Find(Var).Activate
nextrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
ActiveCell.Resize(1, 7).Copy Sheets(2).Cells(nextrow, 1)
If Application.CountIf(.Range("B:B"), Var) > 1 Then
MsgBox Var & " has more than one owner!"
End If
End With
End Sub

 

[Telesphore]

Thank you.

It pastes the first occurence in sheet2.
But we would like to paste all other occurences in sheet2.

Thanks again.

"Toppers" > This copies 7 columns, including active cell i.e. car number to
next

 

[Guest]

Try this ... apologies for error in first posting as I realised shortly
afterwards I hadn't coded for all occurences.


Sub SearchSelectCopyPaste()
Dim Var
Dim nbr_rng As Range
On Error Resume Next
With Sheets(1)
Var = InputBox(Prompt:="What number? ", Xpos:=10, Ypos:=10)

lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
Set nbr_rng = .Range("B1:B" & lastrow)
Set c = nbr_rng.Find(Var, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
nextrow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
c.Resize(1, 7).Copy Sheets(2).Cells(nextrow, 1)
Set c = nbr_rng.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

If Application.CountIf(Sheets(1).Range("B:B"), Var) > 1 Then
MsgBox Var & " has more than one owner!"
End If

End Sub

 

[Telesphore]

Thank you again.

Trying to simplify, I have this now which works partially OK:

Sub SearchSelectCopyPaste()
Dim Var
On Error Resume Next
Var = InputBox(Prompt:="What number?", Xpos:=10, Ypos:=10)

Cells.Find(Var).Activate
ActiveCell.EntireRow.Select
Selection.Copy

'Goes to Sheets2 and paste to row A1
Sheets(2).Select
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
'It is OK until here

Application.CutCopyMode = False
End Sub

What is left now is what happens if there are other occurences of Var in
Sheet1?
I suppose I need a Do... Loop

and the new occurences will be paste in A2, A3 and so on on Sheet2l

 

[Guest]

My (second posing) code does loop through all occurrences - why did you not
use it "as-is"?

 

[Telesphore]

Thanks again.

I copied the code, but nothing happens.

It does not paste.