エクセル起動時に、自動的にＣSVのデータをコピーしたい

質問

いつもお世話になります。

"Book1.csv"が立ち上がっている状態で、同フォルダ内の"Book1.xls"を開き、その瞬間に、"Book1.csv"のA・B列の情報を、"Book1.xls"にコピーしたいのです。
自分でも試してみたのですが、何故か起動しません。

VBAを立ち上げ、ThisWorkbookのところに、
Private Sub File_Open()

Windows("Book1.csv").Activate
d = Range("A1").CurrentRegion.Rows.Count
Range("A2:B" & d).Copy
Windows("Book1.xls").Activate
Range("B4").PasteSpecial Paste:=xlValues

End Sub

としたのですが・・・。
この構文の問題点もご指摘いただけましたら幸いです。

回答No.2

KenKen_SP · ベストアンサー

#1です。補足させて下さい。

ThisWorkbook の Workbook_Open イベントのほか、標準モジュールに Auto_Open という名前でプロシージャを作成すると、ブックの起動時に自動実行されます。以下にサンプルコードをアップしてみます。

Book1.csvが開かれていない場合の例外処理を加えました。

また、値のコピー貼り付けでしたら、 Copy ～ Paste という書き方もOKなのですが、

Range("A1").Value = Range("B1").Value

という書き方も出来ます。この時、複写元のセル領域と転記先のセル領域が異なるとエラーになりますので、Resize でセル領域をそろえます。

値の転記について、どちらの手法が良いかは処理内容によります。
ご参考までに。

Sub Auto_Open()

　　Dim D As Long
　　Dim rngOrg As Range

　　Application.ScreenUpdating = False

　　On Error Resume Next
　　Windows("Book1.csv").Activate
　　If Err.Number <> 0 Then
　　　　MsgBox "Book1.csvが開かれていません", vbCritical, "エラー"
　　　　On Error GoTo 0
　　　　Exit Sub
　　Else
　　　　On Error GoTo 0
　　　　'Book1.csv
　　　　D = Range("A1").CurrentRegion.Rows.Count
　　　　Set rngOrg = Range("A2:B" & D)
　　　　'Book1.xls
　　　　ThisWorkbook.Activate
　　　　With rngOrg
　　　　　　Sheets("Sheet1").Range("B4") _
　　　　　　.Resize(.Rows.Count, .Columns.Count).Value = _
　　　　　　rngOrg.Value
　　　　End With
　　End If
　　Set rngOrg = Nothing

End Sub

お礼

ご丁寧に補足までしていただきまして、ありがとうございます。

よくよく考えてみますと、CSVファイルが立ち上がっていない状態も考えられますので、ぜひ使用させていただきます。

ありがとうございました。

回答No.3

Wendy02

こんにちは。

＞問題点もご指摘いただけましたら幸いです。

問題点ということでしたら、そのコードが、ThisWorkbookにあるからです。
たぶん、最初に、記録マクロで、標準モジュールにあったもので、それをThisWorkbook 側にコピペしたのだと思います。

ThisWorkbook は、すでに、Book1.xls の属性に入っていますから、そこから、そのままでは、他のExcelのWindowsを指定できないはずです。

　Application.Windows("Book1.csv").Activate
などと、親から指定してあげないといけないと思います。

ただ、Windows("ブック名")のは、そのブックの名前と一般的に一致している、というだけですから、Workbooks で指定したほうがよいです。

以下は、なるべく、そのままのコードを活かすようにして直してみましました。

Private Sub File_Open()
　Dim wb As Workbook
　Dim wbCsv As Workbook
　Dim d As Long
　'ブック名（パスがあればパスを含む)
　On Error GoTo ErrHandler
　Set wbCsv = Workbooks("Book1.csv")
　Set wb = Workbooks("Book1.xls")
　　wbCsv.Activate
　　d = Range("A1").CurrentRegion.Rows.Count
　　wbCsv.Worksheets(1).Range("A2:B" & d).Copy
　　wb.Activate
　　wb.Worksheets(2).Range("B4").PasteSpecial Paste:=xlValues
　　'クリップボードに入っているメッセージを出さないで閉じる
　　Application.DisplayAlerts = False
　　wbCsv.Close
　　Application.DisplayAlerts = True

　 Set wbCsv = Nothing
　 Set wb = Nothing
　 Exit Sub
ErrHandler:
　 MsgBox Err.Number & ": (" & Err.Description & ")"
End Sub

お礼

ご丁寧にありがとうございます。
今回初めてThisWorkBOOkを使ったので、勝手が分からず、教えていただきました件につきましては、非常に助かりました。

回答No.1

KenKen_SP

一行目を次のように変更してみてください。

Private Sub Workbook_Open()

余談ですが、

Windows("Book1.xls").Activate
Range("B4").PasteSpecial Paste:=xlValues

でペーストする際にはシートを指定した方が良いです。