[英]Receiving Error when trying to run macro on multiple sheets using VBA
I have the below macro that should be running on each sheet in my workbook.我有以下宏,应该在我的工作簿中的每张纸上运行。 When I run this code, I am getting the following error: 'A table cannot overlap another table' and it is highlighting this line:当我运行此代码时,我收到以下错误:“一个表不能与另一个表重叠”并且它突出显示了这一行:
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$I"), , xlYes).Name = _
"Table1"
Is this because I applied the macro to table one and now it cannot be applied to the other tables?这是因为我将宏应用于表一,现在它不能应用于其他表吗?
All sheets have the same column headers but different number of rows (not sure if that matters).所有工作表都有相同的列标题,但行数不同(不确定这是否重要)。 Essentially all I am trying to do is get rid of the index, format the data into a table, extend the column lengths to fit all the column names, and rename the columns.基本上我要做的就是摆脱索引,将数据格式化为表格,扩展列长度以适应所有列名,然后重命名列。
Another thing to note, there are about 170 sheets that this macro needs to run through.另外需要注意的是,这个宏需要运行大约 170 张纸。
Sub forEachWs()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Call CreateTables(ws)
Next
End Sub
Sub CreateTables(ws As Worksheet)
'
' CreateTables Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
With ws
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("A:I").Select
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$I"), , xlYes).Name = _
"Table1"
Columns("A:I").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight1"
Columns("A:I").EntireColumn.AutoFit
Range("Table1[[#Headers],[Tier2_ID]]").Select
ActiveCell.FormulaR1C1 = "Community ID"
Range("Table1[[#Headers],[Tier2_Name]]").Select
ActiveCell.FormulaR1C1 = "Community Name"
Range("Table1[[#Headers],[Current_MBI]]").Select
ActiveCell.FormulaR1C1 = "Current MBI"
Range("Table1[[#Headers],[countMBI]]").Select
ActiveCell.FormulaR1C1 = "Cout"
Range("Table1[[#Headers],[Cout]]").Select
ActiveCell.FormulaR1C1 = "Count"
Range("Table1[[#Headers],[TotalEDVisits]]").Select
ActiveCell.FormulaR1C1 = "Total ED Visits"
Range("Table1[[#Headers],[EDtoIPTotal]]").Select
ActiveCell.FormulaR1C1 = "Total ED to Inpatient"
Range("Table1[[#Headers],[totalSev1to3]]").Select
ActiveCell.FormulaR1C1 = "Severity 1 to 3"
Range("Table1[[#Headers],[totalSev4to6]]").Select
ActiveCell.FormulaR1C1 = "Severity 4 to 6"
Range("Table1[[#Headers],[totalPaid]]").Select
ActiveCell.FormulaR1C1 = "Total Paid"
Range("L22").Select
End With
End Sub
Table1, Table2, Table3...
.此代码按顺序(重新)命名每个表,即Table1, Table2, Table3...
L22
on each worksheet, you have to make sure the workbook is active (in the first code use If Not wb Is ActiveWorkbook Then wb.Activate
).如果您确实需要 select 每个工作表上的单元格L22
,则必须确保工作簿处于活动状态(在第一个代码中使用If Not wb Is ActiveWorkbook Then wb.Activate
)。 In the second code, you can then use Application.Goto ws.Range("L22")
right before (above) the last 'Else
.在第二个代码中,您可以在最后一个'Else
之前(上方)使用Application.Goto ws.Range("L22")
。Sub ConvertToTables()
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet
Dim n As Long
For Each ws In wb.Worksheets
n = n + 1 ' to create Table1, Table2, Table3...
ConvertToTable ws, "Table", n
Next
End Sub
Sub ConvertToTable( _
ByVal ws As Worksheet, _
ByVal TableBaseName As String, _
ByVal TableIndex As Long)
'
' CreateTables Macro
'
' Keyboard Shortcut: Ctrl+Shift+S
'
' Note that all column names have to be unique i.e. you cannot
' rename the 'countMBI' column to 'Cout' before the existing 'Cout' column
' has been renamed.
Const OldColsList As String _
= "Tier2_ID,Tier2_Name,Current_MBI,Cout," _
& "countMBI,TotalEDVisits,EDtoIPTotal,totalSev1to3," _
& "totalSev4to6,totalPaid"
Const NewColsList As String _
= "Community ID,Community Name,Current MBI,Count," _
& "Cout,Total ED Visits,Total ED to Inpatient,Severity 1 to 3," _
& "Severity 4 to 6,Total Paid"
Const FirstCellAddress As String = "A1"
' Reference the first cell ('fCell').
Dim fCell As Range: Set fCell = ws.Range(FirstCellAddress)
' Check if the first cell is part of a table ('tbl').
' A weak check whether the table has already been created.
Dim tbl As ListObject: Set tbl = fCell.ListObject
If tbl Is Nothing Then ' the first cell is not part of a table
' Reference the range ('rg').
Dim rg As Range: Set rg = fCell.CurrentRegion
' Delete the first column. Note that the range has shrinked by a column.
rg.Columns(1).Delete xlShiftToLeft
' Convert the range to a table ('tbl').
Set tbl = ws.ListObjects.Add(xlSrcRange, rg, , xlYes)
With tbl
.Name = TableBaseName & CStr(TableIndex)
.TableStyle = "TableStyleLight1"
' Write the lists to string arrays ('OldCols', 'NewCols')
Dim OldCols() As String: OldCols = Split(OldColsList, ",")
Dim NewCols() As String: NewCols = Split(NewColsList, ",")
Dim lc As ListColumn
Dim n As Long
' Loop through the elements of the arrays...
For n = 0 To UBound(OldCols)
' Attempt to reference a table column by its old name.
On Error Resume Next
Set lc = .ListColumns(OldCols(n))
On Error GoTo 0
' Check if the column reference has been created.
If Not lc Is Nothing Then ' the column exists
lc.Name = NewCols(n) ' rename the column
Set lc = Nothing ' reset to reuse in the next iteration
'Else ' the column doesn't exist; do nothing
End If
Next n
' The columns should be autofitted after their renaming.
.Range.EntireColumn.AutoFit
End With
'Else ' the first cell is part of a table; do nothing
End If
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.