Set FSO = CreateObject("Scripting.FileSystemObject")
Set SHA = CreateObject("Shell.Application")
Const Header = "       Копирование содержимого каталога в другие"
Path = 1 : DestPath = 1

Do Until Trim(Path) = "" Or FSO.FolderExists(Path)
  Path = InputBox(String(5, vbnewline) & "Введите путь источника:", Header)
  TestFolder Path, ""
Loop

Do Until Trim(DestPath) = ""
  DestPath = InputBox(String(5, vbnewline) & "Введите путь получателя:", Header)
  If DestPath <> "" Then
    Test = 0 : TestFolder DestPath, Test 
    If Not Test Then SHA.NameSpace(DestPath).CopyHere FSO.BuildPath(Path, "*.*")
  End If
Loop

Sub TestFolder(RPath, T)
  If RPath <> "" Then
    If Not FSO.FolderExists(RPath) Then
      T = 1
      M = MsgBox("Такого пути не существует:" & vbNewLine & RPath, _
      vbRetryCancel + vbExclamation, Header)
      If M = vbRetry Then RPath = 1
    End If
  Else
    Set FSO = Nothing : Set SHA = Nothing : WScript.Quit
  End If
End Sub

'Option Explicit
'вводим папку которая будет копироваться
nach = InputBox("Введите исходную папку")
'вводим папку В которую будет копироваться исходная папка
con1 = InputBox("Введите конечную папку 1")
'вводим папку 2 в которую будет копироваться исходная папка
con2 = InputBox("Введите конечную папку 2")

'копируем папку nach в папку con1
CopyFolder nach, con1
'копируем папку nach в папку con2
CopyFolder nach, con2

'проверяем содержимое, если файлы есть, то заменяем
Sub CopyFolder(sSrcPath, sDestPath)
    CreateObject("Shell.Application")_
        .NameSpace(sDestPath).CopyHere sSrcPath
End Sub