Question

我有三个不同的表，当我按一个按钮时，它们也会在不同的工作表中向另一个表发送数据。但是，当一个或两个表为空时，我希望excel忽略该空表。

我尝试使用here中的这段代码，但只添加了一个新的空白行

If WorksheetFunction.CountA(Range("Storningar")) = 1 Then
    tblStorning.DataBodyRange.Copy
    TargetTblLastRow.Range.PasteSpecial xlPasteValues
 End If

也尝试过this，但结果相同：

If tblStorning.DataBodyRange Is Nothing Then
   'Do something if there is no data
Else
  tblStorning.DataBodyRange.Copy
  TargetTblLastRow.Range.PasteSpecial xlPasteValues 'Do something if there is data
End If

这是子查找的一个表，该表将数据从表发送到另一个表而没有IF语句

Sub SkickaStorningar()

Dim tblStorning As ListObject
Dim tblStorningOuput As ListObject
Dim TargetTblLastRow As Variant

Set tblStorning = Worksheets("Rapport").ListObjects("Storningar")
Set tblStorningOutput = Worksheets("Storningar").ListObjects("StorningsTabell")
Set TargetTblLastRow = tblStorningOutput.ListRows.Add

tblStorning.DataBodyRange.Copy
TargetTblLastRow.Range.PasteSpecial xlPasteValues


End Sub

当我按下按钮发送表时，我只想发送包含数据的表，而忽略不包含数据的表

感谢您的帮助

Answer 1

使用新信息进行编辑：您可能有类似这样的内容：

Sub SkickaStorningar()

Dim tblStorning As ListObject
Dim tblStorningOuput As ListObject
Dim TargetTblLastRow As Variant

Set tblStorning = Worksheets("Rapport").ListObjects("Storningar")
Set tblStorningOutput = Worksheets("Storningar").ListObjects("StorningsTabell")
Set TargetTblLastRow = tblStorningOutput.ListRows.Add ' Always adds a row

If tblStorning.ListRows.Count > 0 Then
    tblStorning.DataBodyRange.Copy
    TargetTblLastRow.Range.PasteSpecial xlPasteValues
End If

End Sub

每次运行此宏时，都会在目标表中添加一个新的空白行。仅当if语句的值为TRUE时，才应添加一行。像这样：

Sub SkickaStorningar()

Dim tblStorning As ListObject
Dim tblStorningOuput As ListObject
Dim TargetTblLastRow As Variant

Set tblStorning = Worksheets("Rapport").ListObjects("Storningar")
Set tblStorningOutput = Worksheets("Storningar").ListObjects("StorningsTabell")

If tblStorning.ListRows.Count > 0 Then
    Set TargetTblLastRow = tblStorningOutput.ListRows.Add ' Only execute ListRows.Add if you want to add a row
    tblStorning.DataBodyRange.Copy
    TargetTblLastRow.Range.PasteSpecial xlPasteValues
End If

End Sub

Answer 2

尝试：

Option Explicit

Sub test()

    Dim table As ListObject

    With ThisWorkbook.Worksheets("Sheet1") '<- Change sheet name if needed

        Set table = .ListObjects("tblTest") '<- Change table name

        If Not table.DataBodyRange Is Nothing Then
            'Code
        End If

    End With

End Sub

仅在表有数据时复制

2 个答案: