VBA マクロを使用してブックからブックに転記する方法

Question

エクセルのマクロを使用して、以下の画像のようにブックからブックへ転記をしたいです。
その時、転記元のエクセルファイル（拡張子はxls）が格納されているフォルダを指定してエクセルファイルに「更新」というシートがあるときだけ転記を実行したいです。

以下のソースではフォルダを指定して、そのフォルダ内のファイル名を転記するところまで実装（画像のような転記先のセルの場所の指定はできていません）しているのですが、そのあとで詰まってしまったので教えていただきたいです。

すみませんが、よろしくお願いします。。

Sub Macro()

Dim buf As String, cnt As Long
    Const Path As String = "ここでフォルダのパスを指定"
    buf = Dir(Path & "*.xls")
    Do While buf <> ""
        cnt = cnt + 1
        Cells(cnt, 1) = buf
        buf = Dir()
    Loop

End Sub

転記元

転記先

Comments

[coco_bauer]

質問のコードを実行すると、開いているブック(天気先)のA列に、指定したフォルダーパスにあるファイルのファイル名が順に入るように思われますが、質問の転記先の画像では、A2:A13に"ファイル名１"が入っています。
『以下のソースではフォルダを指定して、そのフォルダ内のファイル名を転記するところまで実装している』と書かれていますが、転記先の画像と矛盾していませんか？

[icecleam]

すみません、『以下のソースではフォルダを指定して、そのフォルダ内のファイル名を転記するところまで実装している』とありますが転記先のセルの指定まではうまくできておらず、画像通りの実装とはなっておりません。
確かに分かりづらいですね、修正しておきます。
ご指摘ありがとうございます

Answer 1

そんな感じです。
ただ、

Set wb = xls.Workbooks.Open(Path & strFile)

の前にファイルがExcel形式（拡張子が.xlsもしくは.xlsx）であることのチェックが必要なのと、

For s = 1 To wb.Worksheets.Count

のsはシート番号なので、snの方がわかりやすいかな、と思います。

Comments

[kuma_kuma_]

>buf = Dir(Path & "*.xls")
元ソースより.xlsもしくは.xlsxどちらでも良いと判断しました。

人のソースのあら探ししていないで、きちんとした回答をなさったほうがよろしいかとおもいますが？

Answer 2

こんな感じでしょうか？

ソースコード

Sub sample1()
    
    Dim lngRowsNo       As Long                     ' 書きこむ位置
    Dim lngSheetIndex   As Long                     ' シートの番号
    Dim strFile         As String                   ' Excelファイルの場所
    Dim xlsAcq          As New Excel.Application    ' 取得側Excel
    Dim wbAcq           As Workbook                 ' 取得側Excelブック
    Dim wsAcq           As Worksheet                ' 取得側Excelシート
    Dim wsSet           As Worksheet                ' 設定側Excelシート
    Const strPath       As String = "ここでフォルダのパスを指定"
    Set wsSet = ActiveSheet
    
    strFile = Dir(strPath & "*.xls")
    lngRowsNo = 1
    Do Until strFile = ""
        '----- Excelブックを開く
        Set wbAcq = xlsAcq.Workbooks.Open(strPath & strFile)
        
        '----- シートを検索
        For lngSheetIndex = 1 To wbAcq.Worksheets.Count
            '----- 「更新」シートを検索
            If wbAcq.Worksheets(lngSheetIndex).Name = "更新" Then
                '----- 「更新」シートを変数へ登録
                Set wsAcq = xlsAcq.Worksheets(lngSheetIndex)
                '----- 「更新」シートの内容を現在のシートにコピー(自由に変更して下さい)
                wsSet.Cells(lngRowsNo, 1) = wsAcq.Cells(1, 1)
                '----- 書きこむ位置移動
                lngRowsNo = lngRowsNo + 1
                '----- 検索の終了
                Exit For
            End If
        Next lngSheetIndex
        
        '----- シート参照の解放
        Set wsAcq = Nothing
        '----- ブックを閉じる
        wbAcq.Close Savechanges:=False
        '----- 次のファイルへ
        strFile = Dir()
    Loop
    
    '----- Excelへの参照の解放
    Set xlsAcq = Nothing

End Sub

Answer 3

転記元セルと転記先セルを指定することで実現できると思います。

Workbooks("転記先ブック名").Worksheet("転記先シート名").Cells(1,1)=Workbooks("転記元ブック名").Worksheet("転記元ブック名").Cells(1,1)

ブック名およびシート名は変数に格納すると効率が良くなります。
あと転記元ブックに「更新」シートが存在しない場合はスキップする処理も必要ですね。