Copy down to last row in a table

[gheyman]

I have a table named "TableForecast". The table headers are on row 6 I want to add a button where when clicked it copies the data from two fields in the table (Date, Qty) from the first table row (7) down to the last row in the table. Where I am lost is that the table can and will be various sizes (number of rows). It can be based on the first column ("Row #") to determine the where the last row is. Reminder this is a table in excel. Thanks for the help

 

[PankajMaheshwari]

Hi @gheyman , assuming that you will always have blank cells in Date and Qty columns before running this copy and paste code, your code will be:

Sub Macro1() 'name your macro here
Application.ScreenUpdating = False

ActiveSheet.ListObjects("Table1").ListColumns("Date").Range(1, 1).Select 'replace "Table1" with your table name.
Selection.End(xlDown).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

ActiveSheet.ListObjects("Table1").ListColumns("Qty").Range(1, 1).Select 'replace "Table1" with your table name.
Selection.End(xlDown).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

ActiveSheet.ListObjects("Table1").Range(1, 1).Select 'replace "Table1" with your table name.

Application.ScreenUpdating = True
End Sub

After this, you can add a button from Develop tab and assign this marco to that button. Hope this helps.

 

[gheyman]

Hi @gheyman , assuming that you will always have blank cells in Date and Qty columns before running this copy and paste code, your code will be:

Sub Macro1() 'name your macro here
Application.ScreenUpdating = False

ActiveSheet.ListObjects("Table1").ListColumns("Date").Range(1, 1).Select 'replace "Table1" with your table name.
Selection.End(xlDown).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

ActiveSheet.ListObjects("Table1").ListColumns("Qty").Range(1, 1).Select 'replace "Table1" with your table name.
Selection.End(xlDown).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

ActiveSheet.ListObjects("Table1").Range(1, 1).Select 'replace "Table1" with your table name.

Application.ScreenUpdating = True
End Sub

After this, you can add a button from Develop tab and assign this marco to that button. Hope this helps.

Thanks! Really appreciate the help. Is there anyway to make this to where it only copies the Date and Qty down to the last row in the table where there is data in the first column ("Row #"). So in the column in the table that is named "Row #" if I only have data in the first five cells (rows) - it only copies the data down to there and not the last row in the table?

 

[PankajMaheshwari]

Hi @gheyman , try this

Sub Macro1() 'name your macro here
Application.ScreenUpdating = False

Dim rowadrs As Long
Dim coladrs As Long
ActiveSheet.ListObjects("Table1").ListColumns("Date").Range(1, 1).Select 'replace "Table1" with your table name.
coladrs = ActiveCell.Column
Selection.End(xlDown).Select
Selection.Copy
ActiveSheet.ListObjects("Table1").ListColumns("Row #").Range(1, 1).Select 'replace "Table1" with your table name.
Selection.End(xlDown).Select
rowadrs = ActiveCell.Row
ActiveSheet.Cells(rowadrs, coladrs).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

ActiveSheet.ListObjects("Table1").ListColumns("Qty").Range(1, 1).Select 'replace "Table1" with your table name.
coladrs = ActiveCell.Column
Selection.End(xlDown).Select
Selection.Copy
ActiveSheet.ListObjects("Table1").ListColumns("Row #").Range(1, 1).Select 'replace "Table1" with your table name.
Selection.End(xlDown).Select
rowadrs = ActiveCell.Row
ActiveSheet.Cells(rowadrs, coladrs).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

ActiveSheet.ListObjects("Table1").Range(1, 1).Select 'replace "Table1" with your table name.

Application.ScreenUpdating = True
End Sub