Forum Discussion
Allan_Smillie
Apr 23, 2024Copper Contributor
copy selected fields and insert into table
Good morning, I am looking for advice on how to start with a problem I have.
I have a sheet where users input information. The data is stored in 6 rows, E7:I12 with each row being a new record.
I would like a macro which can achieve three things
1. Only copy rows where the E column is not blank
2. Copy and insert the non blank rows into a table as new rows, called TblTest
3. Copy and insert a value from cell F16, in an additional column in the tblTest along side each non blank record.
The user input information is contained on worksheet "Calc", tbltest is in worksheet "MyTotal"
What is the best way to achieve this?
I look forward to and appreciate any assistance.
Smillie
For example:
Sub CopyData() Dim ws As Worksheet Dim wt As Worksheet Dim tb As ListObject Dim lr As ListRow Dim s As Long Application.ScreenUpdating = False Set ws = Worksheets("Calc") Set wt = Worksheets("MyTotal") Set tb = wt.ListObjects("TblTest") For s = 7 To 12 If ws.Range("E" & s) <> "" Then Set lr = tb.ListRows.Add lr.Range.Resize(1, 6).Value = ws.Range("E" & s).Resize(1, 6).Value lr.Range(1, 7).Value = ws.Range("F16").Value End If Next s Application.ScreenUpdating = True End Sub
2 Replies
Sort By
For example:
Sub CopyData() Dim ws As Worksheet Dim wt As Worksheet Dim tb As ListObject Dim lr As ListRow Dim s As Long Application.ScreenUpdating = False Set ws = Worksheets("Calc") Set wt = Worksheets("MyTotal") Set tb = wt.ListObjects("TblTest") For s = 7 To 12 If ws.Range("E" & s) <> "" Then Set lr = tb.ListRows.Add lr.Range.Resize(1, 6).Value = ws.Range("E" & s).Resize(1, 6).Value lr.Range(1, 7).Value = ws.Range("F16").Value End If Next s Application.ScreenUpdating = True End Sub
- Allan_SmillieCopper Contributorhans, thank you for this. It is easy to follow and does what I need, thank you.