Excel 総括表のデータを分類して別シートにコピー

質問

マクロの初心者です。
Excel で次の形の総括表(Sheet "TOP")から、項目1の分類にしたがって同名のシートにコピーしてゆき、コピーしてないデータがなくなるまで続けるマクロを作りました。
-----------------------------------------------------
Sheet "TOP"
項目1____項目2_____項目3____項目4____項目5_____項目6_____転記
_ad_______あ________い_______う_______え________お_______レ
_bf_______い________ろ_______は_______に________ほ
_ck_______A_________B________C________D_________E
_dg_______1_________2________3________4_________5
------------------------------------------------------
二つめ以降の Sheet名は "ad" "bf" "ck" "dg"
------------------------------------------------------

Sub 転記()

' データ分別転記

Dim a As Variant
Dim b As Variant

Range("G1").Select '空行検索列の第１行

Do
ActiveCell.Offset(1, 0).Activate '空白でなければ一つ下に移る
a = ActiveCell.Value '変数宣言
Loop While Not IsEmpty(a) '空行検索終了

Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select '行先頭に移動

Do

b = ActiveCell.Value 'セルの文字を記憶

If b = " " Then
Exit Do
End If

Range(Selection, Selection.End(xlToRight)).Select 'コピー範囲を指定

Selection.Copy 'コピーデータ記憶

Sheets(b).Select 'コピー先シートに移動　　★

Range("A1").Select '空行検索列の第１行

Do
ActiveCell.Offset(1, 0).Activate '空白でなければ一つ下に移る
d = ActiveCell.Value '変数宣言
Loop While Not IsEmpty(d) '空行検索終了

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False 'データ貼りつけ
Range("A1").Select 'トップセルに戻る

Application.CutCopyMode = False 'コピー範囲指定を解除
Sheets("TOP").Select '始めのシートに戻る

Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Activate '転記済みチェック欄に移動
ActiveCell.FormulaR1C1 = "レ" '転記欄にチェック

ActiveCell.Offset(1, 0).Activate '一つ下に移る
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select '行先頭に移動

Loop While Not IsEmpty(b) '空行になるまで繰り返し

End Sub
-----------------------------------------------------------------

ひととおり１行ごとにコピー、分類貼り付けはできましたが、最後に Sheet "TOP" の空行の最上行全体が範囲指定され copy mode におかれたような状態になって止まり、次のメッセージが出ます。

「実行時エラー　'9'
　インデックスが有効範囲にありません」

ここでデバッグ・ボタンを押すと、上記の★印の行が指定されます。

どこか正しくないところがあるはずですがよくわかりません。
間違いの箇所と正しい記述を教えて下さい。よろしくお願いします。

回答No.1

may0430 · ベストアンサー

こんにちは。

コピペをして実行してみたのですが、
★印の行より数行上の
　　If b = " " Then
を、
　　If b = "" Then
と修正してみたらとりあえずエラーはでなくなりましたよ^^
(※「"」と「"」の間は空けない。）

ご参考まで。

お礼

may0430さん　ありがとうございました。
見えないことは、ないことではないという、単純な原理を忘れていました。