Public Sub CopyFile(ByVal sPath As String, ByVal sSourceFile As String)
  Dim lPos As Long
  Dim sNewFile As String
  Dim sName As String
  Dim sExt As String
  Dim lNr As Long
 
  lPos = InStrRev(sFile, ".")
  If lPos > 0 Then
    sName = Left(sFile, lPos - 1): sExt = Mid(sFile, lPos)
  Else
    sName = sFile: sExt = ""
  End If
 
  lNr = 0
  Do 
    lNr = lNr + 1
    sNewFile = sPath & sName & "-" & CStr(lNr) & sExt
  Loop Until Dir(sNewFile) = ""
 
  FileCopy sPath & sSourceFile, sNewFile
End Sub