循环宏以创建一个新工作表，对其进行重命名，从网络中添加数据，然后循环返回直到完成

Question

Trying to create a macro to take a spreadsheet with two columns (one with names, the other with a URL to a sheet I need data from), create a new sheet for each row, rename that sheet according to the name in column A, then create a web query in the new sheet according to the URL in column B.

Here's the macro I tried compiling, but it's not working.

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

Made some syntax tweaks that should help as well as error handling if the sheet name already exists. Didn't make any changes to the QueryTable.Add method though.

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