エクセルVBA 無駄な部分をおしえてください

質問

VBA初心者です。
多数のシートを条件によって二つのブックに分ける、というVBAを作ろうとしています。
なにぶん素人なので、無駄な文章が多いのではないかと心配で、
お知恵を拝借できればと思い投稿いたしました。どうぞよろしくお願いいたします。

やりたいこと：Book1のA列に100程度の文字列があり、そのいずれかと一致するシート名（Book1のSheets(2)以降）を持つシートはBook2の最終シートの後ろへ、どの文字列ともシート名が一致しないシートはBook3の最終シートの後ろへ移動。（「最終シートの後ろへ移動」がうまくいっていません）

VBAの内容：Book1のH1に「=countif(A:A,G1)」と入力しておき、G1にシート名を入力させ
H1>0ならば該当シートをBook2へ、それ以外はBook3へ移動　の繰り返し

　　Application.ScreenUpdating = False

Dim j As Integer, k As Integer
j = Workbooks("Book2.xls").Worksheets.Count
k = Workbooks("Book3.xls").Worksheets.Count

Do While Workbooks("Book1.xls").Sheets.Count > 1
Range("G1").Value = Worksheets(2).Name
If Range("H1").Value > 0 Then
Worksheets(2).Move after:=Workbooks("Book2.xls").Sheets(j)
Else
Worksheets(2).Move after:=Workbooks("Book3.xls").Sheets(k)
End If

Loop

回答No.5

Wendy02

微妙な部分なハードルになる部分がいくつもあるようですね。その分、難しいような気がします。
質問のコードとしては、アイデアとしては悪くないものの、今の段階では、完成できないような気がします。

注意：ブック名、シート名は、明示的に入れてください。ただし、wb1.Sheets(1) とwb1.Worksheets("Sheet1")　は、同じものとします。それが違いますと、成功しません。なお、Sheets とWorksheets は、同じようでいて違いますから、注意が必要です。

'//標準モジュールが良い
Sub Test2()
　Dim i As Long
　Dim j As Long, k As Long
　Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
　Dim sh1 As Sheet1

　Set wb1 = ThisWorkbook
　Set wb2 = Workbooks("Book2.xls")
　Set wb3 = Workbooks("Book3.xls")
　Set sh1 = wb1.Worksheets("Sheet1")

　j = wb2.Sheets.Count: k = wb3.Sheets.Count
　'Application.ScreenUpdating = False '*
　For i = wb1.Sheets.Count To 2 Step -1
　　'あり
　　If Application.CountIf(sh1.Columns(1), wb1.Sheets(i).Name) > 0 Then
　　　wb1.Worksheets(i).Move After:=wb2.Sheets(j)
　　Else
　　　'なし
　　　wb1.Worksheets(i).Move After:=wb3.Sheets(k)
　　End If
　Next
　'Application.ScreenUpdating = True '*
　wb1.Activate
　Set wb1 = Nothing: Set wb2 = Nothing: Set wb3 = Nothing
End Sub

*確認したら、外してください。

お礼

＞微妙な部分なハードルになる部分がいくつもあるようですね。
そうなんですよね～。微妙な部分がわかるセンスがほしいです。。。
やはり基礎からきっちり勉強しないとだめですね。

コードありがとうございました。
とても勉強になりました。

回答No.4

wret615

ああ、ありがとう。そうか、ブックアクティブの問題だな。２度目の回答、役に立たなくてすまん。

お礼

＞前回最後にブックを保存したときの状態）でブックを認識するんよ。
なるほど、そりゃそうですね。気づきませんでした。

役に立たないなんてとんでもないです！
貴重な知識を伝授していただき本当にありがたいです。
また何かありましたら相談に参りますので、是非よろしくお願いいたします。

回答No.3

myRange

▲Range("G1").Value = ●Worksheets(2).Name
If ▲Range("H1").Value > 0 Then
●Worksheets(2).Move after:=Workbooks("Book2.xls").Sheets(j)
Else
●Worksheets(2).Move after:=Workbooks("Book3.xls").Sheets(k)
End If

▲や●の部分にブック名やシート名が省略されてるので
それぞれはアクティブブック、アクティブシートを扱っていることになる
よって、２回目以降はうまくいかない。

Workbooks("Book1.xls").Sheets(1)　　　'▲部分に付加
Workbooks("Book1.xls")　　　　　　　　　'●部分に付加

---------------------------------------

ブック名、シート名を付加しないのなら
Do Whileの次か、最後のLoopの前に、

Workbooks("Book1.xls").Activate

を入れてBook1.xlsをいちいちアクティブする必要がある。
---------------------------------------------

ふつうはG1,H1を使用しないで。。。
--------------------------------------------
Sub test()
　Application.ScreenUpdating = False
　Dim Cnt As Integer
　Dim BK1 As Workbook

　Set BK1 = Workbooks("Book1.xls")

Do While BK1.Worksheets.Count > 1
　If WorksheetFunction.CountIf(BK1.Sheets(1).Range("A:A"), BK1.Sheets(2).Name) Then
　　　Cnt = Workbooks("Book2.xls").Sheets.Count
　　　BK1.Sheets(2).Move after:=Workbooks("Book2.xls").Sheets(Cnt)
　Else
　　　Cnt = Workbooks("Book3.xls").Sheets.Count
　　　BK1.Sheets(2).Move after:=Workbooks("Book3.xls").Sheets(Cnt)
　End If
Loop

Application.ScreenUpdating = True
End Sub
'----------------------------------------

以上です。

お礼

スマートですねー。
わざわざコードを書いていただき、本当にありがとうございます。
今回の問題のためだけでなく、勉強になりました。
自力でここまで書けるようになるよう精進いたします！
また何かありましたら相談させてください。
ありがとうございました！！

回答No.2

wret615

それは多分、ブックを保存しないまま続けてコードを動かすから。

保存しないと、コンピュータ側ではコードを動かす前の状態（前回最後にブックを保存したときの状態）でブックを認識するんよ。だから、２度目にコードを動かすと、「あれ、シート数が違うやん」てコンピュータがずっこける。

コード動かしたらBook2とBook3を保存してみ？そしたら続けて使えるはずだ。うまくいったら、VBAコードの最後のほうにSaveメソッド加えるといい。コンピュータが勝手にブック保存してくれるようになるから。

回答No.1

wret615

無駄に思える部分があっても、思ったとおりに動くコードが一番でないかい？

いっこだけ、うまくいってないて部分についてアドバイスすれば、j =とk =の２行をDo Whileの次行に移してみ？

お礼

さっそくご回答いただきありがとうございます。
なるほど、うまくいきました！　順番が間違っていたんですね。たすかりました。

すみません、追加でご相談なのですが、
3ブックを開いて最初の処理はうまくいくのですが
2度目、3度目と続けて実行していると「Moveメソッドに失敗しました」というようなエラー表示が出て、Book2にシートを移動させたあたりでとまってしまいます。

これは何が原因なのでしょうか。