[[20211230033020]]　『【初心者です】「ユーザー定義型は定義されていま』（おいもの子）　ページの最後に飛ぶ

『【初心者です】「ユーザー定義型は定義されていません」と出てしまいます』（おいもの子）

超絶初心者です。
フォルダ内の複数シートがあるファイルの内容を一つのシートにまとめたいのですが、「ユーザー定義型は定義されていません」と出てしまって困っています。
エラー箇所は9行目と出ていますが、よくわかりません…。
一応、参照設定というものを見てみたら、下記のものにチェックが入っていました。これもあっているのかよくわかりません…。

Visual Basic For Applications
Microsoft Excel 16.0 Object Library
OLE Automation
Microsoft Office 16.0 Object Library

Sub 複数ファイルまとめ()

  Dim matomeSh As Worksheet, mitumoriWb As Workbook
  Set matomeSh = Worksheets("見積まとめ")
  Dim fileName As String
  fileName = Dir(ThisWorkbook.Path & "\*.xlsx")

  If fileName <> "" Then
      Dim sh As Workseet
      Dim objSheet As Worksheet
      Dim lastRow As Long
      Dim rng As Range
      lastRow = matomeSh.Cells(Rows.Count, 1).End(xlUp).Row
      Application.ScreenUpdating = False

Do

       Set mitumoriWb = Workbooks.Open(fileName:=ThisWorkbook.Path & "\" & fileName)
        For Each objSheet In ThisWorkbook.Worksheets
         Set rng = sh.Range("A7").CurrentReagion
         lastRow = matomeSh.Cells(Rows.Count, 1).End(xlUp).Row
         rng.Copy matomeSh.Cells(lastRow + 1, 1)
        Next

       mitumoriWb.Close saveChanges:=False
       fileName = Dir()

      Loop Until fileName = ""
      Application.ScreenUpdating = True
      Else
      MsgBox "データがありません"

  End Sub

ここまで、読んでいただきありがとうございます。回答いただけると嬉しいです。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 Dim sh As Workseet
でworksheetのhが抜けてます。
msgboxの後のend ifがないです。

実行時に「sh As Workseet」の部分が黄色くなったはずなので、そこをよく確認することをお勧めします。
また、普通の環境であれば、「Worksheet」の入力途中に入力候補が表示されていたはずなので、それを利用することを念頭に置くべきです。(worksまで入力すれば、worksheetが表示されます。tabで決定できます。「wor」くらいのところからテンキーの↓で探してもよいです）
入力候補をきにしていれば、workseのeを入力した段階（綴りを間違えた段階）で、入力候補の青が消えるはずなので、それでミスに気付けます。
（DS） 2021/12/30(木) 06:59

エラーと関係ありませんが
ここ、ブックやシートの指定が間違って言いませんか

 ＞      Set mitumoriWb = Workbooks.Open(fileName:=ThisWorkbook.Path & "\" & fileName)
 ＞      For Each objSheet In ThisWorkbook.Worksheets
 ＞       Set rng = sh.Range("A7").CurrentReagion

（マナ） 2021/12/30(木) 07:02

DS様、マナ様

ご返信、ありがとうございます。

DS様
ご指摘箇所を直したら、該当部分のエラーが消えました！ありがとうございます！

マナ様
おっしゃる通り、エラーが出てしまいました；；

6行目エラーと出てしまったのですが、直し方がわかりません…。
見様見真似で、複数シートの繰り返しを書いたのですが、どう直したらよろしいでしょうか；；

（おいもの子） 2021/12/30(木) 08:23

 >フォルダ内の複数シートがあるファイル
Set mitumoriWb = Workbooks.Open(fileName:=ThisWorkbook.Path & "\" & fileName)
     For Each objSheet In mitumoriWb.Worksheets
         Set rng = objSheet.Range("A7").CurrentReagion
（どん） 2021/12/30(木) 09:10

 Sub 複数ファイルまとめ()
   Dim matomeSh As Worksheet, mitumoriWb As Workbook
   Set matomeSh = Worksheets("見積まとめ")

   Dim fileName As String
   fileName = Dir(ThisWorkbook.Path & "\*.xlsx")

   If fileName <> "" Then
 '       Dim sh As Worksheets '不要
         Dim objSheet As Worksheet
         Dim lastRow As Long
         Dim rng As Range

 '       lastRow = matomeSh.Cells(Rows.Count, 1).End(xlUp).Row　’不要
         Application.ScreenUpdating = False

         Do
             Set mitumoriWb = Workbooks.Open(fileName:=ThisWorkbook.Path & "\" & fileName)

 '           For Each objSheet In ThisWorkbook.Worksheets　’ブック相違
             For Each objSheet In mitumoriWb.Worksheets
 '               Set rng = sh.Range("A7").CurrentReagion 'Sheet相違、プロパティ名相違
                 Set rng = objSheet.Range("A7").CurrentRegion
                 lastRow = matomeSh.Cells(Rows.Count, 1).End(xlUp).Row
                 rng.Copy matomeSh.Cells(lastRow + 1, 1)
             Next

             mitumoriWb.Close saveChanges:=False
             fileName = Dir()
         Loop Until fileName = ""

         Application.ScreenUpdating = True

     Else
         MsgBox "データがありません"
     End If
 End Sub

（半平太） 2021/12/30(木) 09:30

どん様　半平太様

ご返信ありがとうございます。
初歩的過ぎてお恥ずかしいのですが、matomeShはまとめを貼り付ける先と定義したから、貼りたいシートとは別物なんだなあと目から鱗です；；

ご指摘箇所をわかりやすく書いていただけて勉強になります！ありがとうございます！！！

不要箇所を削除してみたら「ファイル名または番号が不正です」と出てしまいました；；
エラーは5行目のfileName = Dir(ThisWorkbook.Path & "\*.xlsx")だそうです…。
まとめたい複数シートに空白のシートや表がないシートが混在しています…。そのせいでしょうか…。これらのシート(エラーを出すシート)は無視して処理をしたいです。
どなたかご教授していただけると幸いです。
よろしくお願いします。

Sub 複数ファイルまとめ()

   Dim matomeSh As Worksheet, mitumoriWb As Workbook
   Set matomeSh = Worksheets("見積まとめ")
   Dim fileName As String
   fileName = Dir(ThisWorkbook.Path & "\*.xlsx")
   If fileName <> "" Then
         Dim objSheet As Worksheet
         Dim lastRow As Long
         Dim rng As Range
         Application.ScreenUpdating = False
         Do
             Set mitumoriWb = Workbooks.Open(fileName:=ThisWorkbook.Path & "\" & fileName)
             For Each objSheet In mitumoriWb.Worksheets
                 Set rng = objSheet.Range("A7").CurrentRegion
                 lastRow = matomeSh.Cells(Rows.Count, 1).End(xlUp).Row
                 rng.Copy matomeSh.Cells(lastRow + 1, 1)
             Next
             mitumoriWb.Close saveChanges:=False
             fileName = Dir()
         Loop Until fileName = ""
         Application.ScreenUpdating = True
     Else
         MsgBox "データがありません"
     End If
 End Sub

（おいもの子） 2021/12/30(木) 10:16

横からですが私も参加で。

■１
＞参照設定というものを見てみたら、下記のものにチェックが入っていました。
今回は気にしないでＯＫです。

■２
＞マナ様
＞おっしゃる通り、エラーが出てしまいました；；
そうではなくて↓は【ThisWorkbook】のシートを巡回すればいいのか？と言われているのだとおもいますよ。

 For Each objSheet In ThisWorkbook.Worksheets

■３
＞超絶初心者です。
まずは全体の流れを想像するところから初めてみてはどうでしょうか？
すなわち、↓のような流れですよね。

 自ブックとおなじフォルダにある「*.xlsx」ファイルを一つずつ開いていき
    開いたブックの全シートを巡回して
       A7セルが含まれる表範囲をコピーして
       自ブックの「見積まとめ」シートに累積されるように貼り付け
　  全シートの巡回終了

    開いたブックを保存せずに閉じる
 処理していない「*.xlsx」ファイルがなくなるまで繰り返し

■４
＞不要箇所を削除してみたら「ファイル名または番号が不正です」と出てしまいました；；
＞エラーは5行目のfileName = Dir(ThisWorkbook.Path & "\*.xlsx")だそうです…。
そこだけ見る限りおかしくはないとおもいますが・・・なんでですかね。

■５
質問の答えにはなりませんが、↓のようなアプローチもあるとおもいます。行き詰まったら、気分転換に【ステップ実行】して研究してみてください。

    Sub 複数ファイルまとめ_別案()
        Dim 貼付セル As Range
        Dim sh As Worksheet
        Dim コピー範囲 As Range
        Dim ファイル名 As String

        Stop 'ブレークポイントの代わり

        Set 貼付セル = ThisWorkbook.Worksheets("見積まとめ").Range("Ｃ1")
        ファイル名 = Dir(ThisWorkbook.Path & "\*.xlsx")
        Do Until ファイル名 = ""
            With Workbooks.Open(ThisWorkbook.Path & "\" & ファイル名)
                For Each sh In .Worksheets
                    '★↓だと無条件にコピペを実行します
                    Set コピー範囲 = sh.Range("A7").CurrentRegion
                    コピー範囲.Copy 貼付セル
                    貼付セル.Offset(, -2).Resize(コピー範囲.Rows.Count).Value = ファイル名
                    貼付セル.Offset(, -1).Resize(コピー範囲.Rows.Count).Value = sh.Name

                    Set 貼付セル = 貼付セル.Offset(コピー範囲.Rows.Count)
                Next

                .Close False
            End With
            ファイル名 = Dir()
        Loop
    End Sub

（もこな２） 2021/12/30(木) 11:46

もこな2様

ご返信ありがとうございます!
流れを言語化していただき、すごくわかりやすかったです！勉強になります！
別案もいただけて、ありがたいです。ありがとうございます！！！

別案いただいたものも下記箇所でエラーが出てしまっていたのですが、
ファイル名 = Dir(ThisWorkbook.Path & "\*.xlsx")

いろいろ試していたら、デスクトップにフォルダを保存していたことが原因だったようで、
ローカルディスクに保存したらできました！

匿名の場で質問することは初めてだったのですが、皆さんからご丁寧にご教授していただけて、大変勉強になりました！ありがとうございました！

（おいもの子） 2021/12/30(木) 19:07

コメント返信：

[ 一覧(最新更新順) ]

[[20211230033020]] 『【初心者です】「ユーザー定義型は定義されていま』（おいもの子） ページの最後に飛ぶ

[[20211230033020]]　『【初心者です】「ユーザー定義型は定義されていま』（おいもの子）　ページの最後に飛ぶ