#!/usr/bin/perl

use warnings;
use strict;
use File::Copy;

while (my $filename=<*.txt>) {
    next if !($filename =~ m/_(\d{6})\.txt\z/);
    my $date=$1;
    if (!-e $date) {
        mkdir $date;
    } else {
        if (!-d $date) {
            die "$date already exists and is not a folder";
        } elsif (!-x $date) {
            die "Wrong permissions on preexisting folder $date";
        }
    }

    move($filename,"$date/") 
        or die "Couldn't move $filename to $date: $!";
}
[download]

my $newname = $filename;
$newname =~ s/_\d{6}//;
move($filename,"$date/$newname") 
    or die "Couldn't move $filename to $date/$newname: $!";
[download]

... and UNIX (BASH in this case)

#!/bin/bash
for FILE in *.txt
do
   DIR=${FILE##*_}
   DIR=${DIR/.txt/}
   [ ! -d $DIR ] && mkdir $DIR
   mv $FILE $DIR
done
[download]

Try this one.

use strict;
use warnings;
use File::Copy;

my (@files, $file, $folder_name);
opendir(DIR, ".") or die "Can't Open Current Directory: $!";
@files = grep /\d{6}\.txt$/, readdir(DIR);
close DIR;


foreach $file(@files){
    if($file =~ /(\d{6})\.txt$/){
        $folder_name = $1;
        mkdir $folder_name;
        move  $file, "\./$folder_name/";
    }
}
[download]

Thanks,

Rajesh.K

Edit: g0n - replaced pre tags with code tags

Try this....

use File::Copy;
@files = qw(file1_name_051111.txt file2_name_051113.txt file3_name_051
+113.txt file4_name_051110.txt);

foreach $fi (@files)
{
  ($fol) = $fi =~m#(\d{6})\.txt#;
  mkdir $fol;
  copy("$fi", "$fol\\$fi");
  unlink $fi;
}
[download]

Franklin

Edit: g0n - corrected code tags