「 このコード 」 のチェック を お願い致します。

質問

下記コードは何とか動作しますが、チェックお願い致します。

１、 MsgBox "「　空白シート　」　は　ありません。"
　　　の
　　　追加編集が、よくわかりません。

２、　１以外に、おかしな箇所をご教示お願い致します。
---------------------------
'「 ブック１ 」 に空白シートがあったら、そこへ貼り付ける
Sub 空白シートへコピー()
Dim ws As Worksheet

For Each ws In Workbooks("ブック１.xls").Sheets
If IsEmpty(ws.UsedRange) = True Then
Workbooks("ブック２.xls").Activate
Cells.Select
Selection.Copy

Workbooks("ブック１.xls").Activate
ws.Select
Range("A1").Select
ActiveSheet.Paste
Else
MsgBox "「　空白シート　」　は　ありません。"
End If
Next

End Sub

回答No.2

Wendy02 · ベストアンサー

こんにちは。
私も作ってみました。私なら、だいたいは、こんな風です。
シートが空か調べるのは、通常は、WorksheetFunction.Count　を使ったほうが速いです。
ただ、ワークシート関数を使うことをためらうときもありますが。
参考にしてみてください。
本来は、
Workbooks("ブック２.xls").Activate　や
以下のWorkbooks("ブック２.xls").ActiveSheet　
は、明示的に、シートを指定したほうがよいです。

Sub 空白シートへコピー3()
　Dim wsh As Worksheet
　Dim wsh2 As Worksheet
　Dim flg As Boolean

　Set wsh2 = Workbooks("ブック２.xls").ActiveSheet
　For Each wsh In Workbooks("ブック１.xls").Worksheets
　　If WorksheetFunction.Count(wsh.Cells) = 0 Then
　　　 wsh2.Cells.Copy wsh.Range("A1")
　　　 flg = True
　　End If
　Next wsh

　If flg = False Then
　　　MsgBox "「　空白シート　」　は　ありません。"
　End If
　Set wsh2 = Nothing
End Sub

お礼

ご回答、誠に有難うございます。
確かに、早いです。
シート指定を忘れてました。
「Select」の使用が、まだ時間がかかるようでございます。

回答No.1

zap35

元のソースを生かすとして、以下ではどうですか。
「空シート有無」の判定はFor Each～Next文の外に無ければいけません

Sub 空白シートへコピー()
Dim ws As Worksheet
Dim psw As Boolean
For Each ws In Workbooks("BOOK1.xls").Sheets
　If IsEmpty(ws.UsedRange) Then
　　Workbooks("BOOK2.xls").Activate
　　Cells.Copy
　　Workbooks("BOOK1.xls").Activate
　　ws.Select
　　Range("A1").Select
　　ActiveSheet.Paste
　　psw = True
　　Exit For
　End If
Next
If psw = False Then
　MsgBox "「　空白シート　」　は　ありません。"
End If
End Sub

でもこのような空きシートを探すロジックが必要ですか？
BOOK1にシートを追加してコピーするか、BOOK2のシートをBOOK1に直接コピーするのが現実的なロジックではないでしょうか

お礼

ご回答、誠に有難うございます。

＞元のソースを生かすとして、
わざわざ、このようにして頂いたおかげで、No.2様との違いがとても体感できました。

＞でもこのような空きシートを探すロジックが必要ですか？
ちょくちょくと、このようなシートが存在することがありました為でございます。