poslední verze, podle upraveného zadání :

Dim fso, f, sf, sfl, folder, file, filelist, counter, warning, stary, novy
  path = InputBox("Zadejte cestu k nadřazenému adresáři ve kterém se nachází adresáře s obrázky")
  warning = MsgBox("Budou přejmenovány a přesunuty soubory v podadresářích tohoto adresáře: " & path & ". Je to správně?", 276, "Poslední záchrana") 
  if warning = 6 then
  	Set fso = CreateObject("Scripting.FileSystemObject")
  	For i = 1 to 37
		Set f = fso.GetFolder(path & "\" & i)
		fso.MoveFile f.path & "\mapa_run_1.png", f.path & "\mapa_run_1_1.png"
		a = 1
		b = 3
		For j = 1 to 513
			stary = f.path & "\mapa_run_" & "1" & "_" & j & ".png"
			novy = f.path & "\" & i & "-" & ((j+8)\9) & "\" & a & b & ".png"
			fso.MoveFile  stary, novy
			b = b - 1
			
			if b = 0 then
				b = 3
				a = a + 1
				if a = 4 then
					a = 1
				end if
			end if
		next	
	next
end if