Macro to insert a new blank line at the end of a table maintaining formats and formulas of the last one

[robyrux]

Hi all, can somebody please post me a VBA macro to insert a new blank line at the end of a table that maintains the formats and the formulas of the last line?

 

[afonsomira]

Hi.

See if this works:

Sub addRow()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("Table1") ' Change "Table1" for your table name

'add a row at the end of the table
tbl.ListRows.Add

End Sub

 

[NoSparks]

a couple of informative sites for when dealing with tables

The VBA Guide To ListObject Excel Tables

For a data analyst, Excel Tables are a necessity! They are the most efficient way to organize your raw data and refer to data that contracts or expands on a regular basis. Likewise, Excel tables can be extremely useful in combination with VBA.

www.thespreadsheetguru.com

Excel: Working with Tables (VBA)

jkp-ads.com: Excel Tables (VBA)

www.jkp-ads.com

 

[robyrux]

Tks!
It does not work because Table1 is not defined. My table is actually a list of records I am tracking in a worksheet. What I need to do is to be able to add a new blank line at the end with the same format and formulas as the last row and continue editing from there. I could do it with a copy & paste but it is clumsy and not good for others to use as well.

Thanks so much

 

[afonsomira]

In which columns do you have formulas?

 

[afonsomira]

Check this:

Sub addRow()
Dim lastRow As Long
Dim col As Long
Dim row As Long
Dim lastCol As Long
Dim i As Long

lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row

Range("A" & lastRow).EntireRow.Offset(1, 0).Insert

col = 5000

row = 1

lastCol = ActiveSheet.Cells(row, col).End(xlToLeft).Column

Range("A" & lastRow, Cells(lastRow, lastCol)).Copy
Range("A" & lastRow + 1).PasteSpecial xlFormats

For i = 1 To lastCol

If Cells(2, i).HasFormula = True Then
    
    Cells(2, i).Select
    Selection.AutoFill Destination:=Range(Cells(2, i), Cells(lastRow + 1, i))
    
End If

Next i

End Sub

 

[Fluff]

Another option

Sub robyrux()
   With Range("A" & Rows.Count).End(xlUp)
      .EntireRow.Resize(2).FillDown
      On Error Resume Next
      .Offset(1).EntireRow.SpecialCells(xlConstants).ClearContents
      On Error GoTo 0
   End With
End Sub

 

[robyrux]

Another option

Sub robyrux()
   With Range("A" & Rows.Count).End(xlUp)
      .EntireRow.Resize(2).FillDown
      On Error Resume Next
      .Offset(1).EntireRow.SpecialCells(xlConstants).ClearContents
      On Error GoTo 0
   End With
End Sub

Thank you so much! It works!

 

[Fluff]

Glad we could help & thanks for the feedback.