如何使用Excel VBA在表格中水平复制公式？

Question

我有这样的数据：

前两个表格是从第三个表格中计算出来的。

我想编写一个宏，为每个表格添加一列，并同时复制上一列的公式。添加新列很容易，但复制公式却让我遇到了问题。

以下是我目前的代码：

 Sub What()

Dim m As Integer
Dim n As Integer
Dim TableName As String
Dim i As Integer
Dim x As Integer
Dim LastRow As Integer

For i = 1 to 12
TableName = "Table" & i

    With ActiveSheet.ListObjects(TableName)

        .ListColumns.Add

    n = .ListColumns.Count
    m = n - 1

             'this is filling in the first row, with the column number (needed for formulas in the real data)
        .DataBodyRange(1, n).Value = n
        .DataBodyRange(1, n).NumberFormat = "General"

    LastRow = .ListRows.Count

             'this is where I'm trying to copy the formula over to the right
        For x = 2 To LastRow
            .DataBodyRange(x, n) = .DataBodyRange(x, m).Formula
        Next x

    End With

  Next i 

End Sub

这样做的问题在于它直接复制了公式，因此我的新表A1的列F仍然是将表A3的列E的值进行平均。

在我现在拥有的代码之前，我尝试了自动填充（就像这样：

Range("K4").Select
        Selection.AutoFill Destination:=Range("K4:L4"), Type:=xlFillDefault

但我不需要它引用一个范围，我需要它引用一个表格单元格，就像ActiveSheet.ListObjects("Table1").DataBodyRange(3, 2)。我天真地尝试将其替换为目标位置。

ActiveSheet.ListObjects("Table1").ListColumns.Add
        ActiveSheet.ListObjects("Table1").DataBodyRange(1, 2).Select
        Selection.AutoFill Destination:=ActiveSheet.ListObjects("Table1").DataBodyRange(1, 3), Type:=xlFillDefault

并被告知

运行时错误 '1004'： Range类的AutoFill方法失败

我搜索到的所有资源都是关于在列中填充公式，但由于我的数据方向，我需要将其水平而不是垂直复制，并且我没有找到任何相关内容。能否有人帮助我解决这个问题？

非常感谢~

- Sylphie

---

在AutoFill中，Destination不应该包括起始单元格和目标单元格两者吗？ - BigBen

@BigBen 哦，也许吧。我尝试将目标设置为整个第二行（Destination:=ActiveSheet.ListObjects("Table1").ListRows(2).Range），但仍然出现了之前的错误。 - Sylphie

@BigBen 我不知道如何只引用两个表格单元格，这就是为什么我直接跳到整行的原因。 - Sylphie

通过将两个单元格包含在 Range 调用中，例如 Range(.DataBodyRange(1, 2), .DataBodyRange(1, 3))，可以使代码正常运行。您应该能够一次性获取 ListColumn 的整个 Range（不包括第一个单元格），并向右自动填充，而无需循环遍历行。 - BigBen

@BigBen 我使用With ActiveSheet.ListObjects("Table1") .ListColumns.Add .ListRows(2).Range.Select Selection.AutoFill Destination:=Range(.DataBodyRange(1, 2), .DataBodyRange(1, 3)), Type:=xlFillDefault End With 也出现了相同的错误。你能否分享一下你成功的代码？编辑 我也尝试过.ListColumns.Add .DataBodyRange(1, 2).Select Selection.AutoFill Destination:=Range(.DataBodyRange(1, 2), .DataBodyRange(1, 3)), Type:=xlFillDefault，但不起作用。 - Sylphie

Answer 1

• Destination 应包括起始单元格/范围和目标单元格/范围。
• AutoFill 也可以一次完成，而不是从第二行到最后一行的当前循环。
• 无需使用 Select 或 Selection。

然后像这样演示概念 - 根据需要进行修改：

Option Explicit

Sub AutoFillRight()
    Dim myTbl As ListObject: Set myTbl = Sheet1.ListObjects("Table1")
    Dim sourceRng As Range, destRng As Range
    Dim lastRow As Long, lastCol As Long

    With myTbl
        .ListColumns.Add

        lastRow = .ListRows.Count
        lastCol = .ListColumns.Count

        If lastRow > 1 Then
            Set sourceRng = Range(.DataBodyRange(2, lastCol - 1), .DataBodyRange(lastRow, lastCol - 1))
            Set destRng = Range(.DataBodyRange(2, lastCol - 1), .DataBodyRange(lastRow, lastCol))

            sourceRng.AutoFill Destination:=destRng, Type:=xlFillDefault
        End If
    End With
End Sub

- BigBen

---

太好了！很高兴能帮忙。 - BigBen