別ブックからのデータ取り込み

質問

下記の(1)(2)のマクロを(3)のコマンドボタンで実行させています。
(1)(2)を使用せずに(3)のコマンドボタンにまとめて記載したいのですが上手く出来ません。
また、(1)の"A:\あ.CSV"部分ですが、使用PCによってドライブが異なる場合があるります。セルC2に入力したドライブ名を反映させることはできないでしょうか？
よろしくお願いします。

(1) Sub I()
　　　Workbooks.Open Filename:="A:\あ.xls"
　　　lngR = Range("B65536").End(xlUp).Row
　　　Range("B2:B" & lngR).Select
　　　Selection.Copy
　　　Windows("か.xls").Activate
　　　Range("B3").Select
　　　ActiveSheet.Paste
　　　lngR = Range("B65536").End(xlUp).Row
　　　Range("B2:F" & lngR).Select
　　　With Selection.Font
　　　　.Size = 8
　　　End With　　
　　End Sub

(2) Sub II()
　　　Windows("あ.xls").Activate
　　　lngR = Range("E65536").End(xlUp).Row
　　　Range("E2:E" & lngR).Select
　　　Selection.Copy
　　　Windows("か.xls").Activate
　　　Range("G3").Select
　　　ActiveSheet.Paste
　　　lngR = Range("G65536").End(xlUp).Row
　　　Range("G2:G" & lngR).Select
　　　Selection.Style = "Comma [0]"
　　　With Selection.Font
　　　　.Size = 9
　　　End With
　　　Windows("あ.xls").Activate
　　　ActiveWindow.Close
　　End Sub

(3) Private Sub 取込_Click()
　　　Application.ScreenUpdating = False
　　　Protect UserInterfaceOnly:=True
　　　Application.Run "I"
　　　Application.Run "II"
　　　Selection.Locked = False
　　　Applicaion.ScreenUpdating = True
　　End Sub

回答No.3

Ce_faci

おはようございます
遅くなり申し訳ない所存です。
まずは訂正から
lngR = Range("B2").CurrentRegion.Row
の部分は
lngR = Range("B2").CurrentRegion.Rows.Count
です。重ねてお詫び申し上げます。

ご質問に関しては
Dim myドラ As String
Dim myブック As String

myドラ = ActiveSheet.Range("C2").Value
myブック = ActiveSheet.Range("E2").Value & ".csv"
Workbooks.Open Filename:=myドラ & ":\" & myブック
で良いかと思います。

回答No.2

Ce_faci

少し編集してみました。
これで動くようでしたら、再度一まとめにしてみてください。
尚、Sub　I、IIは　Module1　にコピーで、Sub 取込_Clickと同じファイルに入れてください。Windows("あ.csv")　はWorkbooks("あ.csv").Sheets(1)　に変更しました。
Selectはなるべく使用しないようにしました。
最終行を求める方法は２通りにしてあります。

Dim lngR As Long '（3万行ないならIntegerのほうがいいです）
Dim myドラ As String
Sub I()
myドラ = ActiveSheet.Range("C2").Value
Workbooks.Open Filename:=myドラ & ":\" & "あ.xls"
lngR = Range("B2").CurrentRegion.Row
Range("B2:B" & lngR).Copy Destination:=Workbooks("か.xls").Sheets(1).Range("B3")
Workbooks("か.xls").Sheets(1).Activate
Range("B2:F" & lngR + 1).Font.Size = 8
End Sub

Sub II()
Workbooks("あ.csv").Sheets(1).Activate
lngR = Range("E65536").End(xlUp).Row
Range("E2:E" & lngR).Copy Destination:=Workbooks("か.xls").Sheets(1).Range("G3")
Workbooks("か.xls").Sheets(1).Activate
With　Range("G2:G" & lngR + 1）
.Style = "Comma [0]"
.Font.Size = 9
End With
Workbooks("あ.csv").Activate
Workbooks("あ.csv").Close
End Sub

Sub 取込_Click()
Application.ScreenUpdating = False
'Protect UserInterfaceOnly:=True
Call Module1.I
Call Module1.II
'Selection.Locked = False
Application.ScreenUpdating = True
End Sub

補足

おはようございます。

回答No.2の方法を試してみました。
少ない知識と勘で、考えられる限り試行錯誤してみましたが、結果に別の問題が生じてしまいました。
根本的に、作成したBookの構成に起因するものと思われます。
きっと総合的にスマートな方法があるのでしょうが、ここに構成や記述の詳細を全て挙げる時間とスペースがないので、今回は基本的に元の状態で進めます。
いずれアクセスで処理すべきものなのでしょうが・・・

教えて頂いた方法は今後に生かしたいと思います。
ありがとうございました。

それから、この場をお借りしてもう一つ知りたい事があります。

myドラ=ActiveSheet.Range("C2").Value
Workbooks.Open Filename:=myドラ & ":\" & "あ.csv"

上記の"あ"の部分を"E2"から取得する方法はありますか？
こちらも試行錯誤していますが、未だ正解に辿りつけません。
よろしくお願いします。

回答No.1

Ce_faci

おはようございます
まず、何がどのようにまくいかないのでしょう？
もう少しご説明なさらないと、回答にこまります。

>また、(1)の"A:\あ.CSV"部分ですが、使用PCによってドライブが異なる場合があるります

CSVがありません。

また、"A:\あ.CSV"のような、大胆なディレクトリの使い方はリムーバブルディスクということでしょうか？
そういうことといたしまして（細かなディレクトリがある場合はご自分で入れてください、C:\Documents and Settings\Owner\My Documentsとかです）
セルC2にたとえば　A　とかで入れるとして、
Workbooks.Open Filename:="A:\あ.xls"
を
myドラ=ActiveSheet.Range("C2").Value
Workbooks.Open Filename:=myドラ & ":\" & "あ.xls"
にすれば良いかと思います。

>Protect UserInterfaceOnly:=True
ActiveSheet.Protect UserInterfaceOnly:=True
でしょうか。

最後に、（３）におまとめになるのでしたら
Application.Run "I"、Application.Run "II"それぞれの部分を
Sub I、IIの中身をコピー＆ペーストで置き換えれば良いかと思います。

補足

おはようございます。
早朝からの回答ありがとうございます。

＞"A:\あ.CSV"のような、大胆なディレクトリの使い方はリムーバブルディスクということでしょうか？

その通りです。
ファイル指定の部分は教えていただいた記述で解決する事が出来ました。
ありがとうございます。

＞CSVがありません。

すみません。
(1)，(2)の"A:\あ.xls"部分は"A:\あ.CSV"の誤りでした。

(3)の"I","II"の部分をそのまま置き換える方法ですと、
最初のRange("B2:B" & lngR).Selectの部分でエラーになってしまいます。
Workbooksから指定しなおしてみたのですが上手くいきません。

このサイトから似たような例を検索して一部書き換えて使う程度の知識しかなく、自力で解決できませんでした。

現状でも機能はしているのですが疑問に思った次第です。