Data toevoegen aan tabel door een rij toe te voegen en data te plakken

Status
Niet open voor verdere reacties.
T

TWDR

Gebruiker
Lid geworden
26 jun 2017
Berichten
53
Beste Excel en VBA goeroe's,

Ik probeer al een tijdje een stukje code in VBA te schrijven waarbij ik data van de ene sheet kopieer en vervolgens op een andere sheet onderaan een tabel toevoeg. Ik heb een (sterk versimpeld) voorbeeldbestandje gemaakt.

De tabel bestaat uit in totaal uit 7 kolommen. De gekopieerde data bestaat uit 5 kolommen. In de laatste 2 kolommen staan formules in de cellen die betrekking hebben op de eerste 5 kolommen.

Het is de bedoeling dat dmv VBA de data gekopieerd wordt, geplakt wordt onderaan de tabel door tegelijkertijd een nieuwe rij onderin de tabel in te voegen, waardoor de formules in de laatste 2 kolommen worden 'meegetrokken'. Op dit moment wordt de data wel geplakt, maar wordt de tabel niet uitgebreid.

Ik heb het e.e.a. geprobeerd door bijvoorbeeld in de code eerst onderstaande code in te voeren.
Code: 
ShtX.ListObjects("X").ListRows.Add AlwaysInsert:=True

Maar dan loop ik tegen een foutmelding "methode van klasse Range is mislukt".

Heeft iemand de oplossing hiervoor?

Alle suggesties en tips worden zeer gewaardeerd! :thumb:[SQL][/SQL]
 

Bijlagen

  • Testvoorbeeld.xlsm
    18,3 KB · Weergaven: 66
zoiets?

Code: 
Sub test()
Set Lrij = ActiveSheet.ListObjects("Tabel1").ListRows.Add
    Range("A2:E2").Copy
    Lrij.Range.PasteSpecial xlPasteValues 'xlpastevalues mag ook weg volgens mij
End Sub
 
Laatst bewerkt:
Code: 
Sub M_snb()
   Blad1.Cells(2, 1).CurrentRegion.Copy Blad1.ListObjects(1).DataBodyRange.End(xlDown).Offset(1).Resize(, 1)
End Sub
 
of
Code: 
Sub VenA()
   Blad1.ListObjects(1).Range.Cells(1).Offset(Blad1.ListObjects(1).ListRows.Count + 1).Resize(, 5) = Blad1.Cells(2, 1).CurrentRegion.Value
End Sub
 
of:
Code: 
Sub hsv()
 Sheets("test").ListObjects(1).ListRows.Add.Range.Resize(, 5) = Cells(2, 1).Resize(, 5).Value
End Sub
 
Ik heb er nog wel eentje.
Mag je ook in een oneliner stoppen.
Code: 
Sub hsv_2()
 With Blad1.ListObjects(1)
  .DataBodyRange(.ListRows.Count + 1, 1).Resize(, 5) = Cells(2, 1).Resize(, 5).Value
 End With
End Sub
 
@HSV, bij een lege tabel bestaat er geen databodyrange en gaat jouw code in #7 net als de code van @snb in #3 een foutmelding geven. Beide codes passen natuurlijk wel binnen de vraag van de TS.:d
 
Thanks guys!!!

Het is gelukt :d.

Hier kwam ik dus echt niet uit. Mooie codes! Heb nog altijd moeite om codes met name offset en resize goed te begrijpen, hier moet ik mij nog even in verdiepen.
 
Het is gelukt om de code te verwerken in een functie waarbij 1 rij gekopieerd moet worden. :thumb:

Het lukt mij alleen niet om de code te verwerken in een stukje code waarbij dmv een loop telkens een andere rij gekopieerd moet worden, waarbij de eerste 15 waardes in de rij gekopieerd moeten worden. Indien de zoekwaarde 6 keer voorkomt blijft hij 6 keer dezelfde waarde kopiëren. Iemand een idee hoe dit in onderstaande code te verwerken? :(

Code: 
Sub KopieerRijen()

    Dim ShtImportTelefoon As Worksheet
    Dim ShtTelefoondata As Worksheet
    
    Dim foundCell As Range
    Dim foundAdr As String
    
    Dim iRij As Integer
    
    Set ShtImportTelefoon = ThisWorkbook.Worksheets("ImportTelefoondata")
    Set ShtTelefoondata = ThisWorkbook.Worksheets("Telefoondata")
    
        With ShtImportTelefoon.Range("B1:B10000")
            
            'bepaal de zoekwaarde
            Set foundCell = .Find("CM_TEL", LookIn:=xlValues)
                If Not foundCell Is Nothing Then
                    foundAdr = foundCell.Address
                
                    Do
                        
                        'kopieer de gehele rij
                        foundCell.EntireRow.Copy
                        
                        'voeg een nieuwe rij toe onderaan de tabel (zodat de formules worden meegenomen)
                        
                        'plak de eerder gekopieerde eerste 15 waardes van de rij in de sheet 'telefoondata'
                        
                        'bepaal vanaf waar verder moet worden gezocht naar de zoekwaarde
                        Set foundCell = .FindNext(foundCell)
                        
                        'loop door totdat de eerst gevonden waarde weer is gevonden
                        Loop While Not foundCell Is Nothing And foundCell.Address <> foundAdr
                    
                End If
        End With
        
End Sub
 
>1 keer zoeken = filteren

Gebruik dus autofilter of advancedfilter.

.Find is voor jouw doel niet geschikt.
 
****.... Korte situatieschets:

Het betreft een dashboard waarbij maandelijks een sheet met een vast format in het bestand gezet kan worden. Dmv VBA dient de data van deze sheet te worden uitgelezen en toegevoegd aan de tabellen.

Er zijn 3 'skills'. In kolom B staat de skill. De eerste 15 waardes van deze rij moeten gekopieerd en geplakt worden in de tabel. In deze tabel worden in de laatste 8 kolommen formules berekend over de eerste 15 geïmporteerde waardes.

Skill 1 is rij 9 t/m 14
Skill 2 is rij 20 t/m 25
Skill 3 is rij 31 t/m 35

Echter, er kan een variabele wegvallen of bijkomen waardoor die rij nummers niet meer van toepassing staan. In Kolom B staat de skill op basis waarvan bepaald kan worden welke rijen gekopieerd en geplakt moeten worden.



Welke methode kan ik hiervoor het beste gebruiken?
 
Ik kan me er niets bij voorstellen.
 
Ik ga wel even iets anders proberen, thanks voor het meedenken en de codes!! :thumb:
 
Je kan ook een representatief voorbeeldbestand plaatsen.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan