Sub AddRows()
Dim wrksht As Worksheet
Dim oListCol As ListRow
Dim x As Integer, i As Integer
'Cycle through each worksheet
For Each wrksht In ThisWorkbook.Worksheets
'check if any lists on this sheet
x = wrksht.ListObjects.Count
If x > 0 Then
For i = 1 To x
'Add new row to list, place today's date in 1st column
Set oListCol = wrksht.ListObjects(i).ListRows.Add
oListCol.Range(1, 1) = Date
Next i
End If
Next wrksht
End Sub
For i = 1 To x
'Add new row to list, place today's date in 1st column
Set oListCol = wrksht.ListObjects(i).ListRows.Add
oListCol.Range(1, 1) = Date
Next i
to:
If Condition Then
For i = 1 To x
'Add new row to list, place today's date in 1st column
Set oListCol = wrksht.ListObjects(i).ListRows.Add
oListCol.Range(1, 1) = Date
Next i
End If