Vba 原始工作簿中每个工作表中都有动态列的静态表！错误：一个表不能与另一个表重叠

我在一个文件夹中有一堆结果Excel文件和14个不同的键，我必须：

用每个键的名称创建一个工作表！ 在每个工作表中创建一个静态表。 循环浏览结果文件夹并打开每个结果工作簿。 在工作表中为此键命名的表中添加列。 用我刚刚打开的结果工作簿的名称命名此列。 根据键检索数据并将其粘贴到具有新列的表中。 关闭打开的工作簿，然后进入下一个工作簿！ 我在代码中工作，但正如标题中提到的，我在这一行中遇到了一个运行时错误：ActiveSheet.ListObjects.AddxlSrcRange，Selection，xlNo.Name=Table6

每次我运行此代码时，它只在活动工作表中创建一个表，而不是在所有原始工作簿“任务”工作表中创建一个表，并在表中添加一个混乱的列，而不包含所需的标题

    Option Explicit

    Public tbl As ListObject

    Sub createTable()                           'v1a

Dim DS As Worksheet
Dim oTbl As ListObject

[C13].Cut Destination:=[E16]                'move cell [C13] to cell [E16]

' **********************************************
'a loop to clear all the workbook and make sure it runs only once
' **********************************************
For Each DS In ThisWorkbook.Worksheets
 With DS
 .Activate
  On Error Resume Next
  For Each oTbl In DS.ListObjects
        If oTbl.Name = "Table6" Then
            ActiveSheet.ListObjects("Table6").Delete
        End If
      Next oTbl
 End With
Next DS
'**********************************************

[$B$13:$D$18].Select                        'select range for Table..
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlNo).Name = "Table6"
Set tbl = ActiveSheet.ListObjects("Table6") 'assign shortcut

[B13] = "BW"                                'enter table heading in cell
[C13] = "Spec"                              'enter table heading in cell
[D13] = "dBc"                               'enter table heading in cell

[B13:D13].HorizontalAlignment = xlCenter    'apply alignment to cells
[B13:D13].BorderAround Weight:=xlMedium     'draw outer border around range

[14:19].RowHeight = 30                      'set row height for range

[B14] = "1.4MHz"                            'enter BandWidth text in cell
[B15] = "3MHz"                              'enter BandWidth text in cell
[B16] = "5MHz"                              'enter BandWidth text in cell
[B17] = "10MHz"                             'enter BandWidth text in cell
[B18] = "15MHz"                             'enter BandWidth text in cell
[B19] = "20MHz"                             'enter BandWidth text in cell

[B14:B19].HorizontalAlignment = xlCenter    'apply alignment to cells

[B14:B19].BorderAround Weight:=xlMedium     'draw outer border around range
[C14:C19].BorderAround Weight:=xlMedium     'draw outer border around range
[D14:D19].BorderAround Weight:=xlMedium     'draw outer border around range

[G11] = ""                                  'clear cell

ActiveWindow.ScrollColumn = 1               'scroll to column [A]
ActiveWindow.ScrollRow = 2                  'scroll to row 2

[D1].Select                                 'put cellpointer in tidy location

End Sub



    Sub LoopAllExcelFilesInFolder()

    Dim wbk As Workbook
    Dim WS As Worksheet
    Dim Filename As String
    Dim Path As String
    Dim saywhat
    Dim zItem
    Dim arr_Spec(14) As String
    Dim element As Variant
    Dim shtname_loop As Variant
    Dim LastRow As Long
    Dim dBc As Long
    Dim WC As Long
    Dim Spec As String
    Dim BW_static As Long
    Dim BW As Long
    Dim Margin As Long
    Dim RowCount As Integer
    Dim r As Long
    Dim lngStart As String
    Dim lngEnd As String
    Dim BW_Name As String
    Dim BW_row As Integer
    Dim col_num As Integer
    Dim flag As Boolean


    'Spec keys values..
    arr_Spec(0) = "aclr_utra1"
    arr_Spec(1) = "aclr_utra2"
    arr_Spec(2) = "aclr_eutra"
    arr_Spec(3) = "evm_qpsk"
    arr_Spec(4) = "Pout_max_qpsk"
    arr_Spec(5) = "freq_error"
    arr_Spec(6) = "SEM0-1"
    arr_Spec(7) = "SEM1-2.5"
    arr_Spec(8) = "SEM2.8-5"
    arr_Spec(9) = "SEM5-6"
    arr_Spec(10) = "SEM6-10"
    arr_Spec(11) = "SEM10-15"
    arr_Spec(12) = "SEM15-20"
    arr_Spec(13) = "SEM20-25"


    Path = ThisWorkbook.Path       'set a default path

    ' **********************************************
    'a loop to create a table in each sheet
    ' **********************************************
    For Each WS In ThisWorkbook.Worksheets
    With WS
     Call createTable
    End With
    Next WS
    '**********************************************
    'DISPLAY FOLDER SELECTION BOX.. 'display folder picker
    '**********************************************
    With Application.FileDialog(msoFileDialogFolderPicker) 'use shortcut
    saywhat = "Select the source folder for the source datafiles.." 'define browser text
    .Title = saywhat               'show heading message for THIS dialog box
    .AllowMultiSelect = False      'allow only one file to be selected
    .InitialFileName = Path        'set default source folder
    zItem = .Show                  'display the file selection dialog

    .InitialFileName = ""          'clear and reset search folder\file filter

    If zItem = 0 Then Exit Sub     'User cancelled; 0=no folder chosen

    Path = .SelectedItems(1)       'selected folder
    End With                       'end of shortcut
    '**********************************************

    If Right(Path, 1) <> "\" Then  'check for required last \ in path
    Path = Path & "\"              'add required last \ if missing
    End If                         'end of test fro required last \ char

    Debug.Print Path

    Filename = Dir(Path & "*.xlsm")
    Debug.Print Filename

    col_num = 5
    flag = True

    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Do While Len(Filename) > 0
    Set wbk = Workbooks.Open(Path & Filename, ReadOnly:=True)   'define shortcut
    wbk.Activate                                'switch to data file
    'find BW number starting and ending positions
    'which will be between the "_" and "_" in the file name it's like Report_B1_2.xslm
    lngStart = Application.WorksheetFunction.Find("_", ThisWorkbook.Name, 1)
    lngEnd = Application.WorksheetFunction.Find("_", ThisWorkbook.Name, 1)
    'pull BW out of the file name
    BW_Name = Mid(ThisWorkbook.Name, lngStart + 1, lngEnd - lngStart - 1)

    Debug.Print lngStart
    Debug.Print lngEnd
    Debug.Print BW_Name

    Sheets(1).Select                            'switch to first worksheet;

    Dim i As Integer
    LastRow = Cells(Rows.Count, "J").End(xlUp).Row  'last data row; use col[J]

    'loop keysstart to stop
    'create a loop on every Spec for every worksheet in the original workbook
    For Each element In arr_Spec                'check for each bandwidth..
    For i = 35 To LastRow                       'process each data row..
    BW = Cells(i, "G")                          'fetch Bandwidth value from [col [G]
    Spec = Cells(i, "I")                        'fetch carrier type from col [I]

    If Spec = CStr(element) Then
        WC = Cells(i, "L")                  'col [L]=WC
        Margin = Cells(i, "M")               'col [M]=Margin

        Windows("Task.xlsm").Activate
        Worksheets(element).Select

        If flag = True Then 'make sure to add the column only once
           ActiveSheet.tbl.ListColumns.Add(col_num).Name = BW_Name ' add new column for the new Band workbook
           flag = False
        End If

        Select Case BW     'Adjacent Channel Leakage-power Ratio, carrier types
        'case key(iFKey)
        Case Is = 1400000
        BW_row = 14

        Case Is = 3000000
        BW_row = 15

        Case Is = 5000000
        BW_row = 16

        Case Is = 10000000
        BW_row = 17

        Case Is = 15000000
        BW_row = 18

        Case Is = 20000000
        BW_row = 19

        Cells(BW_row, "C") = Spec
        Cells(BW_row, "D") = WorksheetFunction.RoundDown((WC - Margin), 5) 'calculating dBc
        Cells(BW_row, col_num) = Margin

        ActiveWorkbook.Save

        wbk.Activate                                'switch back to data file

        Case Else
        'do nothing
        End Select

    End If

    Next i
    Next element

    wbk.Close True
    Filename = Dir                              'get next data file from folder
    col_num = col_num + 1 'increment the column number for the new band workbook
    flag = True           'turn the flag on to let it add new column
    Loop
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    ResetSettings:
    'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    End Sub

and this is the original createTable macro:

    Sub createTable()
    '
    ' createTable Macro
    '

    '
    Range("C13").Select
    Selection.Cut Destination:=Range("E16")
    Range("B1318").Select
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$13:$D$18"), , xlNo).Name = _
    "Table6"
    Range("Table6[[#Headers],[Column1]]").Select
    ActiveCell.FormulaR1C1 = "BW"
    Range("Table6[[#Headers],[Column2]]").Select
    ActiveCell.FormulaR1C1 = "Spec"
    Range("Table6[[#Headers],[Column3]]").Select
    ActiveCell.FormulaR1C1 = "dBc"
    Range("Table6[[#Headers],[dBc]]").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Range("Table6[[#Headers],[Spec]]").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Range("A17").Select
    Rows("14:14").RowHeight = 30
    Rows("15:15").RowHeight = 31.5
    Rows("16:16").RowHeight = 29.25
    Rows("17:17").RowHeight = 30
    Rows("18:18").RowHeight = 30.75
    Range("B14").Select
    ActiveCell.FormulaR1C1 = "1.4MHz"
    Range("B15").Select
    ActiveCell.FormulaR1C1 = "3MHz"
    Range("B16").Select
    ActiveCell.FormulaR1C1 = "5MHz"
    Range("B17").Select
    ActiveCell.FormulaR1C1 = "10MHz"
    Range("B18").Select
    ActiveCell.FormulaR1C1 = "15MHz"
    Range("B19").Select
    Rows("19:19").RowHeight = 30
    Range("B19").Select
    ActiveCell.FormulaR1C1 = "20MHz"
    Range("B18").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Range("B19").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Range("Table6[BW]").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("Table6[Spec]").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("D1").Select
    ActiveWindow.ScrollRow = 2
    Range("Table6[dBc]").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("G11").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E25").Select
    ActiveWindow.Close
    Range("D17").Select
    ActiveCell.FormulaR1C1 = ""
    Range("D15").Select
    End Sub

createTable中的所有内容都被ActiveSheet限定为引用哪个工作表，因此它将在当前活动的任何工作表上执行

在LoopAllExcelFilesInFolder中，您有一个循环，可以为宏工作簿中的每个工作表调用createTable子例程一次，但不激活这些工作表

For Each WS In ThisWorkbook.Worksheets
With WS
 Call createTable
End With
Next WS

注意：With WS块未在该代码中使用-在任何情况下，您都不会使用的快捷方式。而不是键入WS

解决问题的快捷方法可能是在调用createTable之前激活每个工作表：

更好的方法是重写createTable以正确指定引用的工作表，并可能将该工作表引用作为参数传递给子例程

例如：

并使用

For Each WS In ThisWorkbook.Worksheets
    createTable WS
Next WS

如果您已使用已创建的表保存工作簿，要解决代码崩溃的问题，只需在再次创建表之前删除该表：

Sub createTable()
    [C13].Cut Destination:=[E16]                'move cell [C13] to cell [E16]

    On Error Resume Next
    ActiveSheet.ListObjects("Table6").Delete
    On Error GoTo 0

    [$B$13:$D$18].Select                        'select range for Table..
    ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlNo).Name = "Table6"
    '... etc

---

谢谢你的回答：不幸的是，令人讨厌的答案仍然给出同样的错误！为了获得更好的解决方案，是否将Createtable函数放在一个循环中，以循环工作簿中的每个工作表？我需要一个表的引用，以便以后可以添加一列@Weloo您已经在工作簿中的每个工作表的循环中创建了createTable。b您确定宏工作簿中尝试使用createTable创建表的位置没有表吗？如果是，为什么宏要再次创建它？在createTable函数中设置对该表的引用是没有用的-您需要在使用它时设置引用。我想您可以创建一个模块级数组变量，并在数组的每个位置存储对每个表的引用-但是为什么呢？b我首先在工作表中记录了一个宏来创建一个表，然后将这个宏修复为我现在使用的createtable函数！你认为这就是这个错误的原因吗？c如果Band工作簿结果文件存在，我需要一个引用才能在代码中调用此表并添加新列！我知道解释起来很复杂：顺便说一句，这是我第一次尝试VBA，很抱歉我缺乏创建表的知识，等等：@Weloo b您遇到的错误是因为您试图创建一个表，其中已有一个表，即您在生成原始代码时创建的表。您是否打算在每次运行宏时创建表，即从保存时没有表的工作簿版本开始，还是打算创建一次表，然后再不必创建它们？c当需要添加新列时，可以使用set-tbl=WorksheetsWhicher_sheet.ListObjectsTable6在任何要更新的工作表上设置对表的引用

For Each WS In ThisWorkbook.Worksheets
    createTable WS
Next WS

Sub createTable()
    [C13].Cut Destination:=[E16]                'move cell [C13] to cell [E16]

    On Error Resume Next
    ActiveSheet.ListObjects("Table6").Delete
    On Error GoTo 0

    [$B$13:$D$18].Select                        'select range for Table..
    ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlNo).Name = "Table6"
    '... etc