ファイルを開いた時、CSVデータを自動で取得したい

質問

毎日送られてくるCSVファイルがあります。
今まで手作業で「更新ファイル.exl」を作成していたのですが、開いた時に
自動更新したいと思い、あちらこちらのサンプルから引用したコードを試みましたが、途中で行き詰ってしまいました。
　お力をお借りできれば、幸いです。

やりたことは、（１）「更新ファイル」A列に計算式を入れたい
　　　　　　　（２）CSVファイルのA,B列は除き、C列以降を
　　　　　　　　　　「更新ファイル」のB列から貼り付けたい

現状では、CSVファイル、更新ファイル共にタイトル行がない状態です。
（タイトル行が必要なら、付け加えてもいいのですが、複数のファイルが
この「更新ファイル」から引っ張ったデータを計算式で入れているため、
できるならば現状のままで作りたいのです）

CSVファイル　
A:年　B:月　C:商品コード1　D:商品コード2　E:支払いコード F:個数　G:金額
2007 5 1004 20 1 10 5000

現状：CSVデータそのままの形式で、「更新ファイル.exl」に出力されてしまうので、下記のように出力したいのです。

更新ファイル
A:B&C&D B:商品コード1　C:商品コード2　D:支払いコード E:個数　F:金額
1004201　　　1004 20 1 10 5000

Private Sub Workbook_Open()
Dim Workbooks As Variant
Dim Sheets As Variant
Dim Filename As Variant

ThisWorkbook.Sheets("Sheet1").Activate
Cells.Select
Selection.ClearContents

Filename = Application.GetOpenFilename("CSV ファイル(*.csv),*.csv")

With ActiveSheet.QueryTables.Add _
(Connection:="TEXT;" & Filename, Destination:=Range("A1"))
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
End With

End Sub

　どこに、どんなコードを入れれば解決できるのか、教えて頂けたら、
うれしく思います。よろしくお願いします。

回答No.1

pkh4989 · ベストアンサー

こんにちは。

マクロを直してみました。お試しください。

Sub Workbook_Open()
　　Dim Workbooks As Variant
　　Dim Sheets　　 As Variant
　　Dim Filename　　As Variant
　　Dim wR　　　　 As Long
　　'
　　ThisWorkbook.Sheets("Sheet1").Activate
　　Cells.ClearContents

　　Filename = Application.GetOpenFilename("CSV ファイル(*.csv),*.csv")

　　With ActiveSheet.QueryTables.Add _
　　　　(Connection:="TEXT;" & Filename, Destination:=Range("B1")) '←B列に貼り付け
　　　　.TextFileCommaDelimiter = True
　　　　.Refresh BackgroundQuery:=False
　　End With
　　With ActiveSheet
　　　　.Columns("B:C").Delete Shift:=xlToLeft　　　　　　　　　　 '←CSVファイルのA,B列を削除
　　　　wR = .Range("B" & Rows.Count).End(xlUp).Row
　　　　.Range("A1") = "=B1&C1&D1"　　　　　　　　　　　　　　　　 'A列に式を設定
　　　　.Range("A1").AutoFill Destination:=Range("A1:A" & wR), Type:=xlFillDefault
　　End With
End Sub

お礼

教えて頂いたコードで、希望通りのことができました！
　本当にありがとうございます！！