Excel ブック内の指定したデータのコピーマクロ

質問

よろしくお願いします。

エクセルで自動登録で自動化をしていますが、これだと限界があり今回こちらに書き込みさせていただきました。

流れとしては、マクロスタートでダイアログがでて（可能なら奥底に格納されるブックなのでそのフォルダの一個前辺りの階層指定されて）そこで指定した毎日新しく作られるブック内の指定したシートの指定したセルにあるデータをコピー（ブックは開かないで読み込み）してテンプレートととしている空のブックを開き（開いたまま）指定したシートの指定したセルにペーストするマクロを作りたいです。
（指定したシートと指定したセルの名前は常に同じです）

自動記録で指定したブックを開いて読み込む事は出来ましたが、毎回別のブックなのでそれでは事足りないのです。

ネットで探しましたが…
・ダイアログでファイルを開くマクロは見つけましたが、開いた後内部のデータを読み込むなどマクロは見つかりませんでした。
つながるところがわかりません。

・（存在するブックの場所指定で）ブックを開かないでその中のデータを読み込むマクロは見つけましたが、ダイアログで選ぶけど開かないでと言う事が出来るマクロは見つけられませんでした

これらは元々出来ないのでしょうか？

可能で有ればご教示下ださると助かります。
よろしくお願いします。

回答No.4

kkkkkm · ベストアンサー

> 参照するsansho.xlsのsheet111のＥ１，Ｆ１，Ｇ１から最後の行までの各データを
> テンプレートのtempe.xlsのsheet888のＡ１，Ｂ１，Ｃ１から下へ個々にペーストしたいです。

参照するシートは選択したブックがwbにセットされますからコード上にsansho.xlsは出ません。
シート名やブック名は補足からコピペしています。半角全角などの違いがあればエラーになります。

Sub Test()
Dim myFile As Variant
Dim xls As New Excel.Application
Dim wb As Workbook
Dim LastRow As Long, i As Long

ChDir "C:\test"
myFile = Application.GetOpenFilename("Excel ファイル (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm")

If VarType(myFile) = vbBoolean Then
MsgBox "キャンセルされました"
Else
Set wb = xls.Workbooks.Open(myFile)

For i = Columns("A").Column To Columns("C").Column
LastRow = wb.Worksheets("sheet111").Cells(1, i + 4).End(xlDown).Row
Workbooks("tempe.xls").Sheets("sheet888").Cells(1, i).Resize(LastRow, 1).Value = _
wb.Worksheets("sheet111").Cells(1, i + 4).Resize(LastRow, 1).Value
Next

wb.Close
Set wb = Nothing
Set xls = Nothing
End If

End Sub

お礼

何度も何度も投稿感謝いたします！
まだまだわからない事ありますが頑張って読み解いて活用させていただきます！
本当にありがとうございました！

回答No.3

kkkkkm

> テンプレー.xlsmのsheet1のC1へペーストする--複数列ありま

複数列がどこを指すのか分からないのでF列をC列にコピーします。

Sub Test()
Dim myFile As Variant
Dim xls As New Excel.Application
Dim wb As Workbook
Dim LastRow As Long

ChDir "C:\test"
myFile = Application.GetOpenFilename("Excel ファイル (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm")

If VarType(myFile) = vbBoolean Then
MsgBox "キャンセルされました"
Else
Set wb = xls.Workbooks.Open(myFile)

LastRow = wb.Worksheets("Sheet1").Range("F1").End(xlDown).Row
Workbooks("テンプレート.xlsm").Sheets("Sheet1").Range("C1").Resize(LastRow, 1).Value = _
wb.Worksheets("Sheet1").Range("F1").Resize(LastRow, 1).Value

wb.Close
Set wb = Nothing
Set xls = Nothing
End If

End Sub

お礼

何度も何度も投稿感謝いたします！
まだまだわからない事ありますが頑張って読み解いて活用させていただきます！
本当にありがとうございました！

補足

色々ありがとうございます。
言葉足らずですいません。
参照するsansho.xlsのsheet111のＥ１，Ｆ１，Ｇ１から最後の行までの各データを
テンプレートのtempe.xlsのsheet888のＡ１，Ｂ１，Ｃ１から下へ個々にペーストしたいです。

基本的にマクロ記録で記録させてちょっと手直しをする程度の知識しかないため頂いたコードがシンプル過ぎて（コーピー、ペーストが無いことなど）驚き感激すると同時にに解析に苦労しています(^_^;)
でも楽しいです！。（わかればもっと楽しいでしょうが）

お手すきのときで構いません。
今一度おねがいします。m(__)m

回答No.2

kkkkkm

No1で時間がかかるようでしたら

ExecuteExcel4Macroの方で

Sub Test2()
Dim myFile As Variant
Dim strDir As String
Dim strFile As String

ChDir "C:\test"
myFile = Application.GetOpenFilename("Excel ファイル (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm")

If VarType(myFile) = vbBoolean Then
MsgBox "キャンセルされました"
Else
strDir = Left(myFile, InStrRev(myFile, "\"))
strFile = Mid(myFile, InStrRev(myFile, "\") + 1)
Workbooks("テンプレート.xlsm").Sheets("Sheet1").Cells(2, 1) = ExecuteExcel4Macro("'" & strDir & "[" & strFile & "]Sheet1'!R1C1")
End If

End Sub

お礼

何度も何度も投稿感謝いたします！
まだまだわからない事ありますが頑張って読み解いて活用させていただきます！
本当にありがとうございました！

補足

ありがとうございます！
帰ったら試してみます！

回答No.1

kkkkkm

[ファイルを開く]ダイアログボックスを表示する（GetOpenFilenameメソッド）
https://www.moug.net/tech/exvba/0060013.html

ブックを開かずにセル値を取得（ExecuteExcel4Macro,Excel.Application）
https://excel-ubara.com/excelvba5/EXCELVBA242.html

を参考にして

Sub Test()
Dim myFile As Variant
Dim strFile As String
Dim xls As New Excel.Application
Dim wb As Workbook

ChDir "C:\test"
myFile = Application.GetOpenFilename("Excel ファイル (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm")

If VarType(myFile) = vbBoolean Then
MsgBox "キャンセルされました"
Else
Set wb = xls.Workbooks.Open(myFile)
Workbooks("テンプレート.xlsm").Sheets("Sheet1").Cells(2, 1) = wb.Worksheets("Sheet1").Range("A1")
wb.Close
Set wb = Nothing
End If

End Sub

としたら開いている テンプレート.xlsmにデータが転記できますので試してみてください。
テンプレート.xlsmを開くコードは入ってないので適当なところに入れ込んでください。

お礼

何度も何度も投稿感謝いたします！
まだまだわからない事ありますが頑張って読み解いて活用させていただきます！
本当にありがとうございました！

補足

お世話になります
昨日今日といろいろ試してみていますが、よくわからず( ﾉД`)ｼｸｼｸ…　

自分で自動で登録した下記のマクロを教えていただいたマクロへ組み込みたいのですがどう入れていいのかわかりません。

Range("F1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet1").Select "テンプレー.xlsmのsheet1のC1へペーストする--複数列あります）
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

よろしくお願いできますでしょうか？