[excel vba] Selected range toevoegen aan tabel

[Simkin]

Ik heb geen programmeer ervaring maar heb mbv Google toch een macro proberen te maken, helaas heb ik toch wat hulp nodig.

Ik heb een sheet waar dynamische data op staat. Elke rij bevat een aantal colommen. Ik wil afhankelijk van de data in de eerste colom deze rij (A:L) kopieren naar een ander werkboek en in de juiste tabel zetten. Per data type een aparte tabel.

Het aanmaken van de tabel gaat me goed af maar het toevoegen van de data niet.

Dit is de test macro die ik gemaakt heb:

code:

Sub create_table()

 Dim MyRange As Range
 Dim LastRow As Long
 Dim VAR_TYPE As String
 Dim VAR_TABLE As ListObject
 Dim VAR_TABLEROW As ListRow
 Dim VAR_TESTDATA As Range
 
    ' test data type (normaal uitgelezen van column 1)
    VAR_TYPE = "Sprint 0"
    
    ' zoek laatste rij
    Set MyRange = ActiveSheet.Range("A1")
    LastRow = Cells(ActiveSheet.Rows.Count, MyRange.Column).End(xlUp).Row
    
    ' selecteer juiste tabel
    On Error Resume Next
    Set VAR_TABLE = ActiveSheet.ListObjects(VAR_TYPE)
    
    ' maak tabel indien nog niet aanwezig
    If VAR_TABLE Is Nothing Then
        ActiveSheet.ListObjects.add(xlSrcRange, Range("$A$" & LastRow + 2 & ":$L$" & LastRow + 2), , xlYes).Name = _
         VAR_TYPE
        Set VAR_TABLE = ActiveSheet.ListObjects(VAR_TYPE)
    End If
    On Error GoTo 0
        
    ' Zoek test data
    Columns("C:C").Select
    Set issuefound = Selection.Find(What:="52", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
    :=True, SearchFormat:=False)
    
    ' kopieer test data
    Set VAR_TESTDATA = Range("A" & issuefound.Row & ":L" & issuefound.Row)
    
    ' voeg nieuwe rij toe aan juiste tabel
    VAR_TABLE.ListRows.add
    
    ' Selecteer laatste rij
    Set VAR_TABLEROW = VAR_TABLE.ListRows(VAR_TABLE.ListRows.Count)
    
    ' activeer range
    VAR_TABLEROW.Range.Activate
        
    ' plak de test data
    Set VAR_TESTDATA = VAR_TABLE.InsertRowRange
        
End Sub

Kan iemand mij verder helpen om de test data in de tabel te inserten?
---
Ik heb oa deze pagina als basis gepakt: http://www.jkp-ads.com/Articles/Excel2007TablesVBANL.asp)
Office versie: 2010

---
Ik heb mijn vraag ondertussen ook op ander fora gesteld, mocht ik daar antwoord krijgen dan zal ik deze post ook aanpassen

[psvjw]

Je hebt de variabele issuefound nog niet bovenaan gedeclareerd. Ben ook geen VBA expert, maar dat was het eerste wat me opviel.

Kreeg je ook een foutmelding bij het uitvoeren van de macro? Zo ja, dan is het handig deze even te posten.

[Simkin]

Hoi psvwj, die variabele hoef ik niet te zetten, geen idee waarom. Ik ben wel al weer heel wat verder (trial 'n error). Duidelijk dat ik de stof niet goed beheers, maar stap voor stap kom ik vooruit:)

Waar ik in de fout ging is dat ik blijkbaar een reeks (Range) van waardes (,een aray?,) niet kan toevoegen aan een tabel. Ik loop nu door alle waardes van mijn range heen en vul de tabel, kolom voor kolom. Dit werkt

Zie onder het resultaat

code:

Sub create_table()

 Dim MyRange As Range
 Dim LastRow As Long
 Dim VAR_TYPE As String
 Dim VAR_TABLE As ListObject
 Dim VAR_TABLEROW As ListRow
 Dim VAR_TESTDATA As Range
 Dim VAR_RANGEVALUE As Range
 Dim VAR_OFFSET As Integer
 
    ' Defineer default offset
    VAR_OFFSET = 1
    
    ' test waarde (normaal uitgelezen van column 1)
    VAR_TYPE = "Sprint 0"
    
    ' zoek laatste rij
    Set MyRange = ActiveSheet.Range("A1")
    LastRow = Cells(ActiveSheet.Rows.Count, MyRange.Column).End(xlUp).Row
    
    ' selecteer juiste tabel
    On Error Resume Next
    Set VAR_TABLE = ActiveSheet.ListObjects(VAR_TYPE)
    
    ' maak tabel indien nog niet aanwezig
    If VAR_TABLE Is Nothing Then
        ActiveSheet.ListObjects.add(xlSrcRange, Range("$A$" & LastRow + 2 & ":$L$" & LastRow + 2), , xlYes).Name = _
         VAR_TYPE
        Set VAR_TABLE = ActiveSheet.ListObjects(VAR_TYPE)
    End If
    On Error GoTo 0
        
    ' Zoek test data
    Columns("C:C").Select
    Set issuefound = Selection.Find(What:="52", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
    :=True, SearchFormat:=False)
    
    ' kopieer test data
    Set VAR_TESTDATA = Range("A" & issuefound.Row & ":L" & issuefound.Row)
    Set VAR_TABLEROW = VAR_TABLE.ListRows.add(AlwaysInsert:=True)
    
    ' Verwerk elke aray waarde
    For Each VAR_RANGEVALUE In VAR_TESTDATA
        VAR_TABLEROW.Range.Cells(1, VAR_OFFSET).Value = VAR_RANGEVALUE.Value
        VAR_OFFSET = VAR_OFFSET + 1
    Next VAR_RANGEVALUE
        
End Sub