循环macros创build一个新工作表，重命名它，从networking添加数据，然后循环直到完成

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

这是我试图编译的macros，但它不工作。

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

做了一些语法调整，如果表名已经存在，应该有帮助以及error handling。 虽然没有对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