Forum Discussion

Allan_Smillie's avatar
Allan_Smillie
Copper Contributor
Apr 23, 2024
Solved

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

  • 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

2 Replies

  • 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
    • Allan_Smillie's avatar
      Allan_Smillie
      Copper Contributor
      hans, thank you for this. It is easy to follow and does what I need, thank you.

Resources