excel数据自动导入

切换工作页自动导入网站数据，手动复制粘贴真是弱爆了：

Private Sub Worksheet_Activate()
    Cells.Select
    Selection.Delete Shift:=xlUp
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.sxcoal.com/gjms/index.html", Destination:=Range("$A$1"))
        .Name = "index_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "1"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Cells(3, 6) = Format(Now, "yyyyMMdd_HHMMSS")
    Columns("F:F").EntireColumn.AutoFit
End Sub