Hi erin,

Seeing that we've got this working, I've now cleaned up the code to get rid of a lot of redundant code and added a few comments so you can perhaps see what's going on and can change it to suit yourself.

Also, I have added a Cancel button to Button1_Click to get you out of the situation where you've found what you want to print but there may perhaps be hundreds more listings under the same name...

I dont think you'll have any problems with this, but to be on the safe side, make a copy of your current folder, delete the code in the copy and replace it with this and try it first...

PS: I'll leave it to you to change the english instructions on the message boxes to your own language 

Option Compare Text '<< this allows you to ignore upper & lower Cases
Option Explicit
Sub Button1_Click()
Dim NameToFind As Variant
Dim Cell As Range
Dim Addit As VbMsgBoxResult
Dim AnyMore As VbMsgBoxResult
Dim Counter%
Sheets("Vero").Activate
Application.ScreenUpdating = False
NameToFind = Application.InputBox("Kirjoita nimi?", "Etsi", , 100, 100, , , 2)
If NameToFind = Empty Then
Counter = 0
GoTo NotFound
Else
'counter is really only needed to test whether anything was found
Counter = 0
For Each Cell In Range("Z2:Z200")
'use "Like" for wildcards in If-Then statements
'for an exact match use If Cell = NameToFind Then
If Cell Like "*" & NameToFind & "*" Then
'a Cancel button has been added
Addit = MsgBox("Click Yes to print the record for " & Cell & vbLf & _
"" & vbLf & _
"Click No to look for the next record for " & NameToFind & vbLf & _
"" & vbLf & _
"Click Cancel if you want to start looking for another name", _
vbYesNoCancel, "IS THIS RECORD TO BE PRINTED? >> " & Cell)
Counter = Counter + 1
If Addit = vbYes Then
'copy this row to Sheet1 for printing
Cell.Select
Selection.EntireRow.Copy Destination:=Sheets _
("Sheet1").Range("A65536"). _
End(xlUp).Offset(1, 0)
'if Addit is vbNo it will simply look for the next match
'if Addit is vbCancel it will stop searching for this name
ElseIf Addit = vbCancel Then GoTo NeMore
End If
End If
Next Cell
End If
NotFound:
If Counter = 0 Then MsgBox "Sorry, no " & NameToFind & "s found", _
vbOKOnly, NameToFind & " Not Found"
NeMore:
AnyMore = MsgBox("Add more names?", vbYesNo, "Any More?")
If AnyMore = vbYes Then
Button1_Click
ElseIf Sheets("Sheet1").Range("A2") <> Empty Then
Sheets("Sheet1").Activate
Else: Sheets("Temp").Activate
End If
End Sub
 
 
'//This function is used to find if a workbook's already open
Function WorkbookIsOpen(WorkBookName As String) As Boolean
'//Returns TRUE if the workbook is open
WorkbookIsOpen = False
On Error GoTo WorkbookIsNotOpen
If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
WorkbookIsOpen = True
Exit Function
End If
WorkbookIsNotOpen:
End Function[/vba][vba]Option Explicit
Sub CopyAndPrint()
Dim Wb As Workbook
Dim WS As Worksheet
Dim i As Long
If WorkbookIsOpen("Veroinsiirto.xls") Then
Workbooks("Ast_07.xls").Activate
Else
Application.Workbooks.Open _
(ActiveWorkbook.Path & "\Veroinsiirto.xls")
Workbooks("Ast_07.xls").Activate
End If
'Ast_07.xls is now the activebook
 
Set Wb = Workbooks("Veroinsiirto.xls")
Set WS = Wb.Sheets("Taul2")
Application.ScreenUpdating = False
 
i = 2
Sheets("Sheet1").Activate
Range("A" & i).Activate
'unless stated otherwise, the remaining code
'now always refers to the given Range on Sheet1
Do
WS.Range("A6") = Range("A" & i)
WS.Range("J6") = Range("B" & i)
WS.Range("A16") = Range("Z" & i)
WS.Range("M16") = Range("AA" & i)
WS.Range("H8") = Range("AO" & i)
WS.Range("D10") = Range("AO" & i)
WS.Range("D36") = Range("AV" & i)
WS.Range("J16") = Range("AZ" & i)
WS.Range("A2") = Range("BB" & i)
WS.Range("J2") = Range("BB" & i)
WS.Range("A23") = Range("BD" & i)
WS.Range("J23") = Range("BE" & i)
WS.Range("M23") = Range("BF" & i)
WS.PrintOut copies:=6
'clear the last entry
ActiveCell.Rows.EntireRow.ClearContents
'select the next entry
ActiveCell.Offset(1, 0).Select
i = i + 1
Loop Until ActiveCell = Empty
Wb.Close SaveChanges:=False
Set WS = Nothing
Set Wb = Nothing