przekopiowanie wartosci jezeli wystapi w excelu

WItam,
mam taki problem, że posiadam tabelkę w excelu w Arkuszu1 powiedzmy o zakresie komórek [A1:C100] (czyli razem 100 wierszy po 3 komórki).

Zmagam się z problemem napisania makra które przeszuka te sto wierszy i jeśli w którymś wystąpi wartość 'TAK' w kolumnie A to przekopiuje cały ten wiersz do Arkusza2,
czyli jeśli w stu wierszach w Arkuszu1 wystąpi 5 razy TAK, to Arkusz2 będzie zawierał 5 wierszy.

Proszę o wskazówki jak się do tego dobrać, bo walczę już od wczoraj z tym vba.
pozdro

Sub Szukaj_Tak()

Dim tak As Range, src As Range, dest As Worksheet, aRow As Integer, adr1 As String

Set src = Worksheets("Arkusz3").Range("A1:A100")
Set dest = Worksheets("Arkusz2")
aRow = 1
Set tak = src.Find("TAK")
adr1 = tak.Address
Do While (Not tak Is Nothing)
  For c = 0 To 2
   dest.Cells(aRow, c + 1) = tak.Offset(0, c)
  Next c
  aRow = aRow + 1
  Set tak = src.FindNext(tak)
  If tak.Address = adr1 Then Exit Do
Loop
 Set tak = Nothing
 Set dest = Nothing
 Set src = Nothing
End Sub

Sub Szukaj_Tak()
Dim tak As Range, src As Range, dest As Worksheet, aRow As Integer, adr1 As String

Set src = Worksheets("Arkusz3").Range("A1:A100")
Set dest = Worksheets("Arkusz2")
aRow = 1
Set tak = src.Find("TAK")
If (Not tak Is Nothing) Then
  adr1 = tak.Address
   Do While (Not tak Is Nothing) And (tak.Address <> adr1)
     For c = 0 To 2
      dest.Cells(aRow, c + 1) = tak.Offset(0, c)
     Next c
    aRow = aRow + 1
    Set tak = src.FindNext(tak)
   Loop
End If
 Set tak = Nothing
 Set dest = Nothing
 Set src = Nothing
End Sub

Dzięki wielkie,
makro przepisuje wiersze, ale musiałem lekko zmodyfikować, bo w wierszach pojawiały się jakieś dziwne wartości liczbowe zmiennoprzecinkowe.

Nadal jednak między wierszami w nowym arkuszu pojawiają się jakieś losowe puste wiersze...