[[20210126194054]]　『あるフォルダにある値を、別ブックに転記して集計』（でコパン）　ページの最後に飛ぶ

『あるフォルダにある値を、別ブックに転記して集計するマクロ』（でコパン）

VBA初心者です。複数シートの値を、別ブックに転記していくマクロを作りたいです。
フォルダの中にある、.xlsxファイルがなくなるまでループしたいです。

よろしくお願いいたします。

Sub tenki()

 Dim myPath As String, myBook As String

 'mybookが空白になるまで続ける
Do Until myBook = ""

    myPath = "C:\Users\Manager\Documents\"
    myBook = myPath & "*.xlsx"

  Dim OpenFile As Workbook

  'i は１づつ増えていく
  Dim i As Long
  i = i + 1

  Set OpenFile = Workbooks.Open(myBook)

        'mybookのsheet1のC7セルを、myPath" & "転記.xlsmのA"i"セルにペースト
         Workbooks(myBook).Sheets("sheet1").Range(C7) = Workbooks("myPath" & "転記.xlsm").Sheets("Sheet1").Range("A" & 1)

         'mybookのsheet1のC7セルを、myPath" & "転記.xlsmのA"i"セルにペースト
         Workbooks(myBook).Sheets("sheet1").Range(S1) = Workbooks("myPath" & "転記.xlsm").Sheets("Sheet1").Range("B" & 1)

         'myBookの名前を、C"i"セルにペースト
         myBook = Workbooks("myPath" & "検証.xlsm").Sheets("Sheet1").Range("C" & 1)

    Workbooks(myBook).Close SaveChanges:=False '保存せず閉じる
     myBook = Dir
Loop

 End Sub

＜使用 Excel：unknown、使用 OS：unknown ＞

質問はなんでしょうか？

さしあたって、↓は修正すべきでしょうが…

 myBook = myPath & "*.xlsx"
 Workbooks(myBook)～

 Workbooks("myPath" & "転記.xlsm")～

（もこな２） 2021/01/26(火) 20:13

ついでに。

↓コメント間違ってますよ

 'mybookのsheet1のC7セルを、myPath" & "転記.xlsmのA"i"セルにペースト
  Workbooks(myBook).Sheets("sheet1").Range(S1) = Workbooks("myPath" & "転記.xlsm").Sheets("Sheet1").Range("B" & 1)

↓少なくとも左右逆ですよ

 'myBookの名前を、C"i"セルにペースト
  myBook = Workbooks("myPath" & "検証.xlsm").Sheets("Sheet1").Range("C" & 1)

（もこな２） 2021/01/26(火) 21:00

コメントに書いてある動作を実行したいのですが、うまくいきません。。。
問題点や修正をいただけますと幸いです。

 myBook = myPath & "*.xlsx"
 Workbooks(myBook)～
 Workbooks("myPath" & "転記.xlsm")～
こちらは、フォルダ内にある「・xlsm」を探して全て処理することをしたく記述いたしました
（でコパン） 2021/01/26(火) 21:03

＞うまくいきません。。。
どこがうまくいきませんか？
まずはステップ実行して検証してみましょう

ちなみに、「myBook」の初期値は""ですよ。
↓なにか忘れていませんか？

 Do Until myBook = ""
   myBook = Dir
 Loop

（もこな２） 2021/01/26(火) 21:34

＞問題点や修正をいただけますと幸いです。
既にコメントしているものもありますが。

■１
ステップ実行していれば容易に気づけたと思いますが、↓のように「myBook」に何も代入しなければ、初期値の「""」のままです。
そして、ループ処理の【前】にbufが「""」であればループ終了となっているのですから、ループ部分は一度も実行されないですよね。

    Sub 実験01()
        Dim myBook As String

        Do Until myBook = ""
            myBook = Dir()
        Loop

    End Sub

なので、判定するまえに「myBook」の代入がないとおかしいです。

■２

 myPath = "C:\Users\Manager\Documents\"
 myBook = myPath & "*.xlsx"

↑のように記述した場合、結局「myBook」の中には「"C:\Users\Manager\Documents\*.xls"」という文字列が格納されます。
そのあとに↓のような記述になっていますが、Openメソッドでファイル名を含む、ファイルパスにワイルドカードは使えませんからエラーになります。

 Workbooks.Open("C:\Users\Manager\Documents\*.xls")

■３

 myBook = Dir

↑のように書いてますが、ここもおかしいです。
たしかに↓のように【引数を省略して】書けば、【前回と同じ条件】でDir関数を実行というような意味になりますが、提示のコードでは1回もDir関数を実行してないのですから、前回と同じもへったくれもありません。

 myBook = Dir()

さらに、今回のケースでは↑のように()を付けないとダメです。
（そもそも１回目のほうは、引数を省略しては駄目です）

■４

    myPath = "C:\Users\Manager\Documents\" 
    myBook = myPath & "*.xlsx"
 ★ Workbooks(myBook)～

↑のように書いた場合、★の部分は「C:\Users\Manager\Documents\*.xlsx」という【名前】のブックという意味になります。
そんなブックないですよね？

■５

 ★ Workbooks("myPath" & "転記.xlsm")～

↑のように書いた場合、★の部分は「myPath転記.xlsm」という【名前】のブックという意味になります。
そんな名前のブックがあるのですか？

■６

 Do Until myBook = ""
    Dim OpenFile As Workbook
    Dim i As Long
 Loop

↑のようにループ処理の中に変数の宣言（定義）があるのは適切ではありません。
修正をすることをお勧めします。

■７
↓について「ペースト」という表現はともかくとしてVBAの世界では代入（入力）する場合、右から左へ行くルールです。

 'myBookの名前を、C"i"セルにペースト
  myBook = Workbooks("myPath" & "検証.xlsm").Sheets("Sheet1").Range("C1").Value

したがって、↑のように書いた場合「myBook」という変数に「myPath転記.xlsm」という【ブック】の「Sheet1」というシートの「C1」セルの値を代入するという意味になってます

「myPath転記.xlsm」という【ブック】の「Sheet1」というシートの「C1」セルに、myBook」という変数の中身を書き込むならば↓のようになります。

   Workbooks("myPath検証.xlsm").Sheets("Sheet1").Range("C1").Value = myBook

長くなったので、一旦切ります。

（もこな２） 2021/01/26(火) 23:33

■８
おそらく、変数の宣言を強制しない状態でVBEを使用されているものとおもいます。
無理にとはいいませんが、変数の宣言を強制するように設定を変更されることをお勧めします。
そうすることで↓のようなミスはExcel君が指摘してくれるようになります。

 ～Range(C7)   、  ～Range(S1)
         ^^                ^^
http://officetanaka.net/excel/vba/beginner/06.htm

■９
以上を踏まえて修正するとこんな感じだとおもいます。

    Option Explicit
    Sub tenki_修正()
        Dim myPath As String, myBook As String
        Dim OpenFile As Workbook
        Dim i As Long

        myPath = "C:\Users\Manager\Documents\"
        myBook = Dir(myPath & "*.xlsx") '←■３の説明を参照

        'mybookが空白になるまで続ける
        Do Until myBook = ""
            'i は1づつ増えていく
            i = i + 1

            Set OpenFile = Workbooks.Open(myPath & myBook) '←■２の説明を参照

            'mybookのsheet1のC7セルを、myPath" & "転記.xlsmのA"i"セルにペースト（■７の説明を参照）
            Workbooks("転記.xlsm").Sheets("Sheet1").Range("A" & i).Value = OpenFile.Sheets("sheet1").Range("C7").Value

            'mybookのsheet1の【S1】セルを、myPath" & "転記.xlsmの【B】"i"セルにペースト（■７の説明を参照）
            Workbooks("転記.xlsm").Sheets("Sheet1").Range("B" & i).Value = OpenFile.Sheets("sheet1").Range("S1").Value

            'myBookの名前を、C"i"セルにペースト（■７の説明を参照）
            Workbooks("転記.xlsm").Sheets("Sheet1").Range("C" & i).Value = myBook
            'Workbooks("転記.xlsm").Sheets("Sheet1").Range("C" & i).Value = OpenFile.name '←でもＯＫ

            OpenFile.Close SaveChanges:=False '←修正

            myBook = Dir() '←■３の説明を参照
        Loop
    End Sub

（もこな２） 2021/01/27(水) 08:29

残念ながら反応がなくなってしまいましたが、コメント抜いて見やすくした版もおいておきます。

    Sub さんぷる()
        Dim フォルダパス As String, ブック名 As String
        Dim 出力行 As Long

        フォルダパス = "C:\Users\Manager\Documents\"

        ブック名 = Dir(フォルダパス & "*.xlsx")
        Do Until ブック名 = ""
            With Workbooks.Open(フォルダパス & ブック名)
                出力行 = 出力行 + 1

                Workbooks("転記.xlsm").Sheets("Sheet1").Range("A" & 出力行).Value = .Sheets("sheet1").Range("C7").Value
                Workbooks("転記.xlsm").Sheets("Sheet1").Range("B" & 出力行).Value = .Sheets("sheet1").Range("S1").Value
                Workbooks("転記.xlsm").Sheets("Sheet1").Range("C" & 出力行).Value = .Name

                .Close SaveChanges:=False
            End With

            ブック名 = Dir()
        Loop
    End Sub

（もこな２） 2021/01/28(木) 07:45

コメント返信：

[ 一覧(最新更新順) ]

[[20210126194054]] 『あるフォルダにある値を、別ブックに転記して集計』（でコパン） ページの最後に飛ぶ

[[20210126194054]]　『あるフォルダにある値を、別ブックに転記して集計』（でコパン）　ページの最後に飛ぶ