SOLVED

# copy selected fields and insert into table

Copper Contributor

# copy selected fields and insert into table

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

2 Replies
best response confirmed by Allan_Smillie (Copper Contributor)
Solution

# Re: copy selected fields and insert into table

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
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``````

# Re: copy selected fields and insert into table

@hans, thank you for this. It is easy to follow and does what I need, thank you.
1 best response

Accepted Solutions
best response confirmed by Allan_Smillie (Copper Contributor)
Solution

# Re: copy selected fields and insert into table

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