Sub search_answer()
Dim ws As Worksheet
Dim current_ws As Worksheet
Dim ans As String
Dim last_row As Long
Dim i As Long
Dim j As Long
Set current_ws = ThisWorkbook.Sheets("Answers")
ans = "Ans1"
lastrow = current_ws.Cells(current_ws.Rows.Count, "A").End(xlUp).Row
lastQ = 10
If Not Evaluate("ISREF('" & ans & "'!A1)") Then Sheets.Add.Name = ans
Set ws = ThisWorkbook.Sheets("Ans1")
Start_row = "1"
Start_col = "A"
End_row = lastrow
End_col = lastQ
start_cell = Start_col & Start_row
end_cell = ws.Cells(End_row, End_col).Address(RowAbsolute:=False, ColumnAbsolute:=False)
ws.Range(start_cell & ":" & end_cell).Value = current_ws.Range(start_cell & ":" & end_cell).Value
For j = 2 To lastQ + 1
For i = 2 To lastrow
If current_ws.Cells(i, j).Value = ans Then
ws.Cells(i, j) = current_ws.Cells(i, j)
ws.Range("A1").Name = current_ws.Name
Else
ws.Cells(i, j) = 0
End If
Next i
Next j
End Sub