AlleDateien kopieren

Sub Verschieben()
Dim arrFiles As Variant
Dim intCounter As Integer
Dim strSource As String, strTarget As String
Dim strFirst As String, strSecond As String
strSource = "c:\1"
strTarget = "c:\2"
arrFiles = FileArray(strSource, "*.*")
If arrFiles(1) = False Then Exit Sub
For intCounter = 1 To UBound(arrFiles)
strFirst = strSource & "\" & arrFiles(intCounter)
strSecond = strTarget & "\" & arrFiles(intCounter)
If Dir(strSecond)  "" Then
If FileDateTime(strFirst) > _
FileDateTime(strSecond) Then
Kill strSecond
Name strFirst As strSecond
End If
Else
Name strFirst As strSecond
End If
strFirst = ""
strSecond = ""
Next intCounter
End Sub

Function FileArray( _
ByVal strPath As String, _
ByVal strPattern As String)
Dim arrDateien()
Dim intCounter As Integer
Dim strDatei As String
If Right(strPath, 1)  "\" Then strPath = strPath & "\"
strDatei = Dir(strPath & strPattern)
Do While strDatei  ""
intCounter = intCounter + 1
ReDim Preserve arrDateien(1 To intCounter)
arrDateien(intCounter) = strDatei
strDatei = Dir()
Loop
If intCounter = 0 Then
ReDim arrDateien(1)
arrDateien(1) = False
End If
FileArray = arrDateien
End Function

Ich möchte gern alle Dateien kopieren.
Kann mir bitte jemand zeigen wie der Code dafür aussieht.
Vielen Dank im Voraus
MFG Andre