nicht 2x kopieren

Sub Datei_verschieben3()
'Dieser Code kopiert eine Datei in die Ordnerstruktur der Tabelle
   Dim Zeilen As Long, Pfad As String, FullPfad As String, i As Long
   Dim Vorlage As String
'   Vorlage = "C:\Users\marcu\Desktop\3 Fertig - Kopie\1.txt"
Vorlage = ActiveWorkbook.Path & "\Problemlösungsblatt.xlsm"
'   hier die zele eingeben mit einem buchstaben wo gesucht werden soll
   Zeilen = Cells(Rows.Count, "q").End(xlUp).Row
   Pfad = ActiveWorkbook.Path & "\"
'   Range("B1")
   For i = 1 To Zeilen
'   hier die zele eingeben mit einem zahl wo gesucht werden soll
     FullPfad = Pfad & Cells(i, 22) & "\" & Range("w2") & "\"
     If Dir(FullPfad, vbDirectory) > "" Then
         FileCopy Vorlage, FullPfad & Dir(Vorlage)
     Else
'         MsgBox FullPfad & "   nicht vorhanden"
     End If
   Next i
 End Sub