ブック間貼り付け

Question

Private Sub CommandButton21_Click()

'■指定したフォルダのXLS系ファイルを選択して、開く

Dim OpenFileName As String
ChDrive "C"
ChDir "C:\Users\Desktop\123"
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
If OpenFileName <> "False" Then
    Workbooks.Open OpenFileName
Else
    MsgBox "キャンセルされました"
End If

'■直前作業したWindowsに戻す

Windows(2).Activate

'■ B2～H2 データある行まで選択してコピー

Range("B2:H2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

'■直前作業したWindowsに戻す

Windows(2).Activate

'■シート［0］に貼り付けしたい部分に先にデータクリアします

Sheets("0").Select

**'ここまではできました｡

'以降にエラーが出ました｡ 進行できなくなったので。
**
エラー内容
実行時エラー 1004
RangeクラスSelect メソッドが失敗しました。

Range("A1:N150").Select
Application.CutCopyMode = False
Selection.ClearContents

'■選択した範囲シート［0］に貼り付け

' Range("B2").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False

お手数ですがが、教えてください。

Comments

[ttyp03]

具体的にどこの行で止まりますか？エラーメッセージは？聞かなくても回答できるように最低限の情報は載せてくださいね。

[coco_bauer]

二つ目の"Windows(2).Activate"では、同じworkbookが選択されるのではないですか？　SelectやActivateの対象は、workbookやworksheetを明示的に使うべきだと思います。

[xhdl78]

coco_bauerさん　コメントいただいてありがとうございました。二つ目のwindows(2)は　先開いたブックに戻りました。目的は作業したブック選択した内容を　先開いたブックに貼り付けの準備です。開いたブックがシートの選択可能ですですが、セルの選択はできないです。

Answer 1

質問のコードからは、何がしたいのか理解できません。
.xlsファイルを選択して開いた後、元々開いていたBookに戻ってデータをCopy。
そして、また元々開いていたBookに戻ってデータを貼り付けしようとしているのですから。

本当は、元々開いていたBookのシート［0］に、選択して開いた.xlsファイルのデータをコピーしたいのではないでしょうか？

もし、そうだとするとコードは以下のような感じになるのでは？

Private Sub CommandButton21_Click()
    Dim origWorkbook as workbook, selectedWorkbook as workbook '元のbookと選択して開くbookを保存する変数を用意しておきます。
    Dim OpenFileName As String

  Set origWorkbook = activeWorkbook '元のworkbook

'■指定したフォルダのXLS系ファイルを選択して、開く
  ChDrive "C" 
  ChDir "C:\Users\Desktop\123" 
  OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") 
  If OpenFileName <> "False" Then 
    set selectedWorkbook = Workbooks.Open OpenFileName '選択して開いたbook
  Else 
    MsgBox "キャンセルされました" 
  End If

  selectedWorkbook.Activate 'これが無くても選択して開いたbookがactivateされているはずだが、念のため。(この行の手前に別のbookをActivateするようなコードが入ると想定外の動作が起きるので、この行を入れておくと安全)

'■ B2～H2 データある行まで選択してコピー
  Range("B2:H2").Select 
  Range(Selection, Selection.End(xlDown)).Select 
  Selection.Copy

'■元のbookに戻る Windows(2).Activateに比べて、どのbookがActivateされるのかが判り易い。
  origWorkbook.Activate

'■貼り付ける先のシート［0］をActivate
  Sheets("0").Activate

  Range("A1:N150").Select 
  Application.CutCopyMode = False 
  Selection.ClearContents

'■選択した範囲シート［0］に貼り付け

  Range("B2").Select 
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False

End Sub

Comments

[xhdl78]

'■元のbookに戻る Windows(2).Activateに比べて、どのbookがActivateされるのかが判り易い。
丁寧な説明　ありがとうございました。理解しました。

Answer 2

原因は詳しく調べていませんが、以下のどちらかの対処でうまくいくのではと思います。

１. エラーになるRangeのコードを次のように修正する。

Sheets("0").Select
Range("A1:N150").Select
↓
Sheets("0").Range("A1:N150").Select

２. コードを標準モジュールに置く

こちらの場合、コードの修正は不要です。

Comments

[xhdl78]

ご回答いただいてありがとうございました。無事解決できました。