Копировать, только если в таблице есть данные

Question

У меня есть три разных таблицы, которые при нажатии кнопки отправляют данные и в другие таблицы на разных листах. Однако, когда одна или две таблицы пусты, я хочу, чтобы Excel игнорировал пустую таблицу / s

Я пытался использовать этот код из здесь , но он добавляет только новую пустую строку

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

Пробовал это один, но тот же результат:

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

Попробуйте:

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

Answer 2

Редактирование с новой информацией: Возможно, у вас есть что-то вроде этого:

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