シートに記載のパスワード付きファイルを開き、コピペする

Sub CopyDataFromWorkbooks()
    
    ' リストシートを指定
    Dim wsList As Worksheet
    Set wsList = ThisWorkbook.Sheets("リスト")
    
    ' B列の最終行を取得
    Dim lastRow As Long
    lastRow = wsList.Cells(wsList.Rows.Count, 2).End(xlUp).Row
    
    ' ループ処理開始
    Dim i As Long
    For i = 2 To lastRow
    
        ' シート名を取得
        Dim sheetName As String
        sheetName = wsList.Cells(i, 3).Value
        
        Dim flg As Boolean
        flg = ExistSheet(sheetName, ThisWorkbook)
        ' シートがあるとき、シート削除
        If flg Then
            ' 保存確認させない状態にする
            Application.DisplayAlerts = False
            
            ThisWorkbook.Worksheets(sheetName).Delete
        
            ' 保存確認する状態に戻す
            Application.DisplayAlerts = True
        End If
        
        ' ターゲットシートを指定
        Dim targetSheet As Worksheet
        ' 新規シートを最後尾に追加
        Set targetSheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
        targetSheet.Name = sheetName
        
        ' パスワードを取得
        Dim password As String
        password = wsList.Cells(i, 4).Value
        
        ' ソースフォルダのパスを取得
        Dim sourceFolder As String
        sourceFolder = wsList.Cells(i, 5).Value
        
        ' ファイル名を取得
        Dim fileName As String
        fileName = sourceFolder & "\" & wsList.Cells(i, 2).Value & ".xlsx"
        
        ' ファイルがないときは、メッセージを表示させ、次の行を処理する
        If Dir(fileName) = "" Then
            MsgBox fileName & vbCrLf & "が存在しません"
        Else
            ' エラー無視
            On Error Resume Next
            
            ' ブックを開く
            ' 読み取りパスワードを使用
            ' 外部参照、リモート参照ともに更新しない
            ' 読み取り専用で開く
            Dim wb As Workbook
            Set wb = Workbooks.Open(fileName:=fileName, _
                    password:=password, UpdateLinks:=0, ReadOnly:=True)
                
            If Err.Number <> 0 Then
                MsgBox fileName & vbCrLf & "を開けませんでした"
            
                ' エラー無視解除
                On Error GoTo 0
            
            Else
                ' エラー無視解除
                On Error GoTo 0
                
                
                ' ブックのデータを取得
                Dim ws As Worksheet
                Set ws = wb.ActiveSheet ' アクティブシート
                
                ' データを貼り付け
                ws.Cells.Copy
                targetSheet.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
                
                ' 保存確認させない状態にする
                Application.DisplayAlerts = False
                
                ' ブックを閉じる
                wb.Close False
                
                ' 保存確認する状態に戻す
                Application.DisplayAlerts = True
            End If
        End If
    Next i
End Sub

'*************************
'* シートが存在しているかどうか確認する関数。存在する場合は、Trueを返す
'* shetName：調べたいシート名を指定
'* book：調べたいワークブックを指定
Function ExistSheet(ByVal sheetName As String, ByVal book As Workbook) As Boolean
    Dim ws As Worksheet, flag As Boolean
    ' すべてのワークシートを表す Worksheets コレクションからひとつずつ
    ' Worksheetを取り出して、名前を確認します。
    For Each ws In book.Worksheets
        If ws.Name = sheetName Then flag = True
    Next ws
    If flag = True Then
        ExistSheet = True
    Else
        ExistSheet = False
    End If
End Function