VBA Code to auto expand excel table and copy last row data of table

sharma7s

New Member
Joined
Jan 24, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I need help with VBA code. I am using Excel table, need VBA code to auto expand and copy last filled row to next row. Although table auto expands with tab key in last filled row or any manual data entry but this doesn't happen when complete row (from index) is selected and pasted below.

Please help.

Thanks in Advance
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Welcome to MrExcel Message Board.
I supposed your table name is Table1 and Range of it at column A to C ( from A1), Change if you need
Try this:
VBA Code:
Sub AddAfterLastrow()
Dim I As Long, Lr As Long, Tbl1 As ListObject, ws As Worksheet
Set ws = ActiveSheet
Set Tbl1 = ws.ListObjects("Table1")
Lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Tbl1.Resize ws.Range("A1:C" & Lr + 1)
ws.Range("A" & Lr + 1 & ":C" & Lr + 1).Value = ws.Range("A" & Lr & ":C" & Lr).Value
End Sub
 
Upvote 0
Welcome to MrExcel Message Board.
I supposed your table name is Table1 and Range of it at column A to C ( from A1), Change if you need
Try this:
VBA Code:
Sub AddAfterLastrow()
Dim I As Long, Lr As Long, Tbl1 As ListObject, ws As Worksheet
Set ws = ActiveSheet
Set Tbl1 = ws.ListObjects("Table1")
Lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Tbl1.Resize ws.Range("A1:C" & Lr + 1)
ws.Range("A" & Lr + 1 & ":C" & Lr + 1).Value = ws.Range("A" & Lr & ":C" & Lr).Value
End Sub
@ maabadi thanks for your help.
while the code works perfectly fine to copy the last row and resize the table, it doesn't copy the formula's to the new rows and this partially solves the issue. Please see if it can be modified to copy formulas as well.

Thanks again
 
Upvote 0
Try this:
VBA Code:
Sub AddAfterLastrow()
Dim I As Long, Lr As Long, Tbl1 As ListObject, ws As Worksheet
Set ws = ActiveSheet
Set Tbl1 = ws.ListObjects("Table1")
Lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Tbl1.Resize ws.Range("A1:C" & Lr + 1)
ws.Range("A" & Lr & ":C" & Lr).Copy ws.Range("A" & Lr + 1 & ":C" & Lr + 1)
End Sub
 
Upvote 0
Solution
Try this:
VBA Code:
Sub AddAfterLastrow()
Dim I As Long, Lr As Long, Tbl1 As ListObject, ws As Worksheet
Set ws = ActiveSheet
Set Tbl1 = ws.ListObjects("Table1")
Lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Tbl1.Resize ws.Range("A1:C" & Lr + 1)
ws.Range("A" & Lr & ":C" & Lr).Copy ws.Range("A" & Lr + 1 & ":C" & Lr + 1)
End Sub
Works Perfectly fine!! Thanks for your help :)
 
Upvote 0

Forum statistics

Threads
1,213,567
Messages
6,114,342
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top