表の取り出し【コード】

Sub 表の取り出し()
Dim objIE As Object
Dim tbl As Object
Dim cel As Object
Dim x As Integer
Dim y As Integer
Dim a As Integer
Dim snam As String

'新しいシートを作成し、名前を変更する
Worksheets.Add
snam = ActiveSheet.Name

'InternetExplorerをobjIEに代入し、IEのプロセスを起動
Set objIE = CreateObject("InternetExplorer.Application")
    
    'IEを可視化するか = はい
    objIE.Visible = True
    
    'IEのリンク先URLはB1のセルのURL
    objIE.Navigate Worksheets("情報").Range("B1").Value
    
    'IEの表示待ち
    wait objIE
    
    'objIEのHTMLの中からtableのタグをtblに代入しながら確認
    For Each tbl In objIE.Document.GetElementsByTagName("table")
        
        'tblに代入されたtableタグのIDがlistの場合
        If tbl.ID = "list" Then
            
                'tblに代入されているtableタグにあるセルをExcelに移し変える
                
                '変数yに0を代入、tblに代入されているtableの行数まで繰り返す
                For y = 0 To tbl.Rows.Length - 1
                    '変数xに1を代入、tblに代入されているtableの列数まで繰り返す
                    For x = 0 To tbl.Rows(y).Cells.Length - 1
                        'Excelのx+1列、y+1行の位置にtableタグのx列、y行のセルの値を入れる
                        Worksheets(snam).Cells(y + 1, x + 1).Value = tbl.Rows(y).Cells,(x).InnerText
                    Next
                Next
        End If
    Next
    
    '終了のメッセージボックスを表示
    MsgBox "終了"
    
    'objIEに代入したInternetExplorerを閉じる
    objIE.Quit
    
    'objIEを空にする
    Set objIE = Nothing

End Sub

Sub wait(objIE As Object)
'objIEに代入されたInternetExplorerがビジー状態、もしくは読み込み待ちの間、処理を待つ
Do While objIE.Busy Or objIE.ReadyState < 4
    DoEvents
Loop
End Sub