copy selected fields and insert into table

[Allan_Smillie]

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

[#2 · Accepted solution]

@Allan_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

[#3]

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