Question

我对VBA还是很陌生，我的要求是在工作簿中所有表的末尾添加一个新列，并将最后使用的列值复制到具有格式的新列中。

Sub LoopThroughAllTablesinWorkbook()    
    Dim tbl As ListObject
    Dim sht As Worksheet
    Dim SheetName As String

    For Each sht In ThisWorkbook.Worksheets
        SheetName = sht.Name
        For Each tbl In sht.ListObjects  
           If (tbl.Name like ("TableSL_" & Right(SheetName,2)) = True or tbl.Name Like ("Table" & SheetName) = True) Then          
               With tbl.ListColumns(tbl.ListColumns.Count).Range
                   .Copy .Offset(0, 1)
               End With       
        Next tbl
    Next sht 
End Sub

Name  Vorname User id
Nag     Vad     123
Siv     VAd     456
Reddy   Tav     769
Ravi    Kakki   123

结果应为

Name  Vorname User id User id2
Nag    Vad    123     123
Siv    VAd    456     456
Reddy  Tav    769     769
Ravi   Kakki  123     123

Answer 1

您遍历每个工作表中每个listobject的循环是正确的-您需要更改对表的操作以复制最后一列，但是：

Sub foo()
    Dim sht As Worksheet
    Dim tbl As ListObject
    For Each sht In ThisWorkbook.Worksheets
        For Each tbl In sht.ListObjects
            With tbl.ListColumns(tbl.ListColumns.Count).Range
                .Copy .Offset(0, 1)
            End With
        Next tbl
    Next sht
End Sub

编辑：

如果要在复制最后一列之前测试表名，请添加一个IF ... END IF部分：

Sub AddNewColumn()
    Dim tbl As ListObject
    Dim sht As Worksheet

    For Each sht In ThisWorkbook.Worksheets
        For Each tbl In sht.ListObjects
            If tbl.Name Like ("TableSL_" & Right(sht.Name, 2)) Or tbl.Name Like ("Table" & sht.Name) Then
                With tbl.ListColumns(tbl.ListColumns.Count).Range
                    .Copy .Offset(0, 1)
                End With
            End If
        Next tbl
    Next sht
End Sub

我编辑了您的问题以改善代码格式-希望您可以看到，当您仔细注意缩进时，缺少的End If语句变得显而易见。

如何在Excel表格中动态复制最后一列范围和过去的下一列范围

1 个答案:

编辑：