#!/usr/local/bin/perl

use Cwd;
use File::Copy;

$dir = Cwd::getcwd();

opendir(DIR,$dir);

while($_ = readdir(DIR)){
    if($_ eq "."){next;}
    if($_ eq ".."){next;}
    @file_list = (@file_list,$_);
}

closedir(DIR);

foreach $filename (@file_list){
     if($filename =~ /(.*)_(\d*)\.(.*)/){
           unless(-d $1){
               mkdir("$dir/$1",0755);
           }
           copy($filename, $1."/".$filename);
           unlink($filename);
     }
}

Cygwin版のPerlで試したらうまく動いた。
ActivePerlはもっていないので、未テスト。
現在ダウンロード中