EXCEL 2007 VBA データを振分け別シートに転記

質問

EXCEL 2007 VBA　データを振分け別シートに転記

http://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+201004/10040047.txt
↑ こちらのサイトでHirofumi様（2010/04/15(木) 11:25:12）の VBAを拝見しました。
同じような事を実行したかったので拝借したのですが

「実行時エラー'1004':
　アプリケーション定義またはオブジェクト定義のエラーです。」

と表示され、デバッグすると以下の部分が黄色に反転します。

rngResult.Resize(lngCount, clngTransfer).Value = _
rngList.Offset(lngTop, clngStart).Resize(lngCount, clngTransfer).Value

WinXP /　Excel97 と前出のサイト頁トップに記載されていました。
データ量が20万行程ありExcel97では処理できないからでしょうか？
私は Excel2007 を使用しています。関係無いかな？

訂正個所が解る方おられましたらご指南よろしくお願い致します。

ソースを貼り付けようとしたら文字数オーバーで無理でした;;

回答No.1

imogasi

元のコードは読みにくい。こんなことをしなくても
（１）Ａ列でソートする
（２）下記を実行する
２０万件のソートは多少時間がかかるかも知れないが、その後は、２０万件を１回読み終われば、処理は終わる。
区分ごとにシートを分ける例です。
ーー
Ａ、Ｂ列しか無い例に簡略化。Ｂを適当に実情の列に合わせる。
A25000をA250000に変える。
Sub test01()
'--振り分けの基準のデータはＡ列にあると言う場合のコード。Ａ列でソート済みのこと。
Dim sh1 As Worksheet
Set sh1 = Worksheets("Sheet1")
d = sh1.Range("A25000").End(xlUp).Row '最終行取得
strt = 2 '第２行目がデータスタート行
For i = 2 To d '最終行まで繰り返し
If sh1.Cells(i, "A") = sh1.Cells(strt, "A") Then 'Ａ列でスタート行セルと現在行セルを比べ変わったか
Else
'--変わった場合
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Select 'シートを増やす
sh1.Range("A" & strt & ":B" & i - 1).Copy Selection.Range("A2") '増やしたシートのＡ２からに貼り付け
strt = i 'スタート行を入れ替え
End If
Next i
　　’－－後仕舞い
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Select 'シートを増やす
sh1.Range("A" & strt & ":B" & i - 1).Copy Selection.Range("A2") '増やしたシートのＡ２からに貼り付け
End Sub

お礼

ありがとうございます。感激です^^
非常にスムーズに動作してくれますので、作業がとっても楽になりました。

恐縮ですが以下の点もご教示頂ければ幸いです。

お示し頂いたマクロを動作させると、Sheet2からＡ列の分類数が自動で追加されますが
●●●はsheet2 ・ ●◎◎はsheet3 ・ ○○○はsheet4 … ○●◎はsheet47
それ以外はsheet名「ERR」という具合にするのは手間がかかるでしょうか？

お忙しい中申し訳ございませんが、よろしくお願い致します。