Web剪贴簿页面工作表需要在excel中的一个工作表上

Question

我编写了代码，但是代码存在一些问题。

1. 所有页面显示在单独的页面上，而不是一页。
2. 如果定义了20000到20001范围，则不应给出结果，因为没有页面具有该范围，但是在此代码中它给出的结果是，不知道从何处来。

    Option Explicit
    Public Sub GetRestuarantInfo()
        Dim s As String, re As Object, p As String, page As Long, r As String, json As Object
        Const START_PAGE As Long = 2
        Const END_PAGE As Long = 4
        Const RESULTS_PER_PAGE As Long = 30

        p = "\[{""@context"".*?\]"
        Set re = CreateObject("VBScript.RegExp")

        Application.ScreenUpdating = False

        With CreateObject("MSXML2.XMLHTTP")

            For page = START_PAGE To END_PAGE
                .Open "GET", "https://www.yellowpages.com/atlanta-ga/restaurants?page=" & page, False
                .send
                If .Status = 200 Then
                    s = .responseText
                    r = GetValue(re, s, p)
                    If r <> "Not Found" Then
                        Set json = JsonConverter.ParseJson(r)
                        WriteOutResults page, RESULTS_PER_PAGE, json
                    End If
                End If
            Next
        End With
        Application.ScreenUpdating = True
    End Sub
    Public Sub WriteOutResults(ByVal page As Long, ByVal RESULTS_PER_PAGE As Long, ByVal json As Object)
        Dim sheetName As String, results(), r As Long, headers(), ws As Worksheet
        ReDim results(1 To RESULTS_PER_PAGE, 1 To 3)

        sheetName = "page" & page
        headers = Array("Name", "Website", "Tel")
        If Not WorksheetExists(sheetName) Then
            Set ws = ThisWorkbook.Worksheets.Add
            ws.Name = sheetName
        Else
            ThisWorkbook.Worksheets(sheetName).Cells.ClearContents
        End If
        With ws
            Dim review As Object
            For Each review In json  'collection of dictionaries
                r = r + 1
                results(r, 1) = review("name")
                results(r, 2) = review("url")
                results(r, 3) = review("telephone")
            Next
            .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
            .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
        End With
    End Sub

    Public Function GetValue(ByVal re As Object, inputString As String, ByVal pattern As String) As String
    'https://regex101.com/r/M9oRON/1
        With re
            .Global = True
            .MultiLine = True
            .IgnoreCase = False
            .pattern = pattern
            If .Test(inputString) Then
                GetValue = .Execute(inputString)(0)
            Else
                GetValue = "Not found"
            End If
        End With
    End Function

    Public Function WorksheetExists(ByVal sName As String) As Boolean  '@Rory https://stackoverflow.com/a/28473714/6241235
        WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
    End Function

由于我是网络抓取新手，请帮助解决问题。