vba - 循环宏以创建新工作表、重命名、从网络添加数据，然后循环返回直到完成

Question

尝试创建一个宏来获取包含两列的电子表格(一列带有名称，另一列带有指向我需要数据的工作表的 URL)，为每一行创建一个新工作表，根据 A 列中的名称重命名该工作表，然后根据 B 列中的 URL 在新工作表中创建 Web 查询。

这是我尝试编译的宏，但它不起作用。

Sub CreateSheetsFromAList()

    Dim wb As Workbook
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim MyCell As Range, MyRange As Range, URLCell As Range

    Set wb = ThisWorkbook
    Set src = wb.Sheets("AllPlayers")
    Set MyRange = Sheets("AllPlayers").Range("A1")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    Set URLCell = Sheets("AllPlayers").Range("B1")
    Set URLCell = Range(URLCell, URLCell.End(xlDown))

    For Each MyCell In MyRange
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = MyCell.Value
        With ActiveSheet.QueryTables.Add(Connection:=URLCell, Destination:=Range("$A$2"))
        .Name = "2015"
        .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 = """pgl_basic"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    Next MyCell
End Sub

Answer 1

如果工作表名称已经存在，则进行了一些语法调整，这些调整应该会有所帮助以及错误处理。未对 QueryTable.Add 进行任何更改方法虽然。

Sub CreateSheetsFromAList()

    Dim wb As Workbook
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim ActSht As Worksheet
    Dim MyCell As Range, MyRange As Range, URLValue As Variant

    Set wb = ThisWorkbook
    Set src = wb.Sheets("AllPlayers")
    Set MyRange = src.Range("A1:A" & src.Range("A" & src.Rows.Count).End(xlUp).Row)

    For Each MyCell In MyRange
        On Error Resume Next
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = MyCell.Value
        If Err.Number > 0 Then
            Err.Clear
            MsgBox MyCell.Value & " sheet name already exists"
            Exit Sub
        End If
        On Error Goto 0
        URLValue = MyCell.Offset(0, 1).Value
        Set ActSht = Sheets(Chr(34) & MyCell.Value & Chr(34))
        With ActSht.QueryTables.Add(Connection:= "URL;" & URLValue, Destination:=ActSht.Range("A2"))
          .Name = "2015"
          .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 = """pgl_basic"""
          .WebPreFormattedTextToColumns = True
          .WebConsecutiveDelimitersAsOne = True
          .WebSingleBlockTextImport = False
          .WebDisableDateRecognition = False
          .WebDisableRedirections = False
          .Refresh BackgroundQuery:=False
        End With
    Next MyCell
End Sub