Hi,

I wrote a macro that searches a word and copy the datas right next to it into the new worksheet I create at the beginning of the macro. I have two Problesms:
- the code does neither copy nor paste
- there could be more than once the same word and how I can search all of them and copy & paste the datas vertically row by row starting in Cells(1,1)

Option Explicit
Sub Makro1()
Dim wsNew As Worksheet
Dim ws As Worksheet
Dim rng As Range
Dim sAddress As String
Dim sFind As String
Dim BoVorhanden As Boolean

For Each ws In Worksheets
If ws.Name = "Graphics" Then
BoVorhanden = True
End If
Next ws
If BoVorhanden = False Then
Set wsNew = Worksheets.Add
With wsNew
.Name = "Graphics"
.Move after:=Sheets(Sheets.Count)
End With
Set wsNew = Nothing
End If

sFind = InputBox("Please enter word:")

For Each ws In Worksheets
If ws.Name Like "Tool*" Then
Set rng = ws.Cells.Find( _
what:=sFind, _
lookat:=xlWhole, _
LookIn:=xlFormulas)
If Not rng Is Nothing Then
Set rng = ws.Range(rng.Offset(0, 1), rng.End(xlToRight))
rng.Copy _
Destination:=Sheets("Graphics").Cells(1, 1)



End If
End If
Next ws
MsgBox prompt:="There aren't new words!"

End Sub