VBAfフォルダの複数ファイル内の複数シートを一括取込み

Question

実現したいこと

大量のエクセルシートをすべて抽出。

発生している問題・分からないこと

VBAでフォルダのなかにある複数ファイル内から複数シートを一括取込むと同じシートが重複して抽出されてしまうのですが原因がわかりません。
取り込む際重複したシート名には違う名前がふられていきますがどうもシートによっては２度ほど処理を繰り返しているようです。
アドバイスをいただけますと幸いです。

該当のソースコード

On Error Resume Next
  Dim FileName    As String
Dim IsBookOpen  As Boolean
Dim OpenBook    As Workbook
Dim ShCount     As Long
With CreateObject("WScript.Shell")
    .CurrentDirectory = "C:\Users\----\Desktop\取込用"
End With
FileName = Dir("*.xlsx")
Do While FileName <> ""
    If FileName <> ThisWorkbook.Name Then
        IsBookOpen = False
        For Each OpenBook In Workbooks
            If OpenBook.Name = FileName Then
                IsBookOpen = True
                Exit For
            End If
        Next

        If IsBookOpen = False Then
            ShCount = ThisWorkbook.Worksheets.Count
            Workbooks.Open (FileName), UpdateLinks:=1
            Worksheets.Copy after:=ThisWorkbook.Worksheets(ShCount)
            Workbooks(FileName).Close savechanges:=False
        End If
    End If
    FileName = Dir()
Loop

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

いろいろ調べましたがどうも原因がわかりませんでした。

補足

特になし

Answer 1

On Error Resume Next

とりあえず、上記のステートメントはコメントアウトして下さい。

その上で、Workbooks オブジェクトの Open メソッドの戻り値として返されたブックへの参照を Workbook オブジェクト型の変数に渡した上、その変数を介してブックの操作を行うようにしてください。

Dim FileName    As String
Dim IsBookOpen  As Boolean
Dim OpenBook    As Workbook
Dim ShCount     As Long

Dim FileName    As String
Dim IsBookOpen  As Boolean
Dim OpenBook    As Workbook
Dim ShCount     As Long
Dim TargetBook  As Workbook

            Workbooks.Open (FileName), UpdateLinks:=1
            Worksheets.Copy after:=ThisWorkbook.Worksheets(ShCount)
            Workbooks(FileName).Close savechanges:=False

            Set TargetBook = Workbooks.Open(FileName:=FileName, UpdateLinks:=1)
            TargetBook.Worksheets.Copy after:=ThisWorkbook.Worksheets(ShCount)
            TargetBook.Close SaveChanges:=False
            Set TargetBook = Nothing

Comments

[hajihaji]

回答ありがとうございます。
試したところ問題が解決しました！
ベストアンサーに選ばせていただきました。