Gegevens kopiëren naar een ander document

Status
Niet open voor verdere reacties.

TommyV2209

Gebruiker
Lid geworden
1 apr 2020
Berichten
22
Ik heb 2 documenten waar ik gegevens uit een tabel (Eenmalig - invoer) naar een andere tabel (Dim_Eenmalig - uitvoer) in een ander document wil kopiëren.
Beide tabellen hebben een identieke structuur. Ik heb beide bestanden in bijlage toegevoegd.

De bedoeling is dat hij enkel de rijen selecteert waar er effectief gegevens ingevuld staan. Die gegevens komen nog vanuit een andere tabel in het invoerbestand. Daar zijn automatische links aan gekoppeld (dwz dat er eigenlijk geen enkele cel volledig leeg is, maar gewoon uitgeblankt is als er geen gegevens worden gevonden). Ik wil nu enkel de volledige rijen kopiëren waar er effectief een tekst is ingevuld in kolom A.

Ik gebruik onderstaande code. Nu stoot ik op volgende problemen:
- VBA kopieert alle 100 rijen, terwijl ik maar 2 rijen effectief wil kopiëren (want maar 2 rijen echt gevuld)
- wat als er een of meerdere lege rijen tussen staan in de tabel? Zal VBA dan nog altijd alle gevulde rijen kunnen kopiëren en de lege rijen overslaan?

Code:
Sub Knip_plak_onderlaatsterij()
' vind de laatst gebruikte rij in allebei de werkbladen en knip en plak de gegevens onder de bestaande gegevens

Dim wsKnip As Worksheet
Dim wsPlak As Worksheet
Dim lKniplaatsterij As Long
Dim lPlaklaatsterij As Long

' variabelen definiëren
  Set wsKnip = Workbooks("Invoertest.xlsb").Worksheets(1)
  Set wsPlak = Workbooks("Uitvoer.xlsb").Worksheets("Dim_Eenmalig")
    
' 1) laatste rij vinden in de copy range (gebaseerd op gegevens in kolom A)
' klopt nog niet, want ik wil enkel de rijen kopiëren waarin er gegevens staan en niet alle rijen in de tabel
  lKniplaatsterij = wsKnip.Cells(wsKnip.Rows.Count, "A").End(xlUp).Row
    
' 2) vind de eerste lege rij in de doelrange (gebaseerd op gegevens in kolom A)
' offset om 1 rij naar beneden te gaan dan de laatste rij
  lPlaklaatsterij = wsPlak.Cells(wsPlak.Rows.Count, "A").End(xlUp).Offset(1).Row

' 3) knippen en plakken
  wsKnip.Range("A2:J" & lKniplaatsterij).Cut _
    wsPlak.Range("A" & lPlaklaatsterij)

' 4) selecteer het doelwerkblad
  wsPlak.Activate
  
End Sub

Wie kan me verder helpen met dit probleempje?

Alvast bedankt!
 

Bijlagen

  • Invoertest.xlsb
    34,2 KB · Weergaven: 16
  • Uitvoer.xlsb
    22,2 KB · Weergaven: 18
Bv.

Code:
Sub VenA()
  With Sheets("Etl_eenmalig").ListObjects(1).Range
    .AutoFilter 1, "<>"
    .Offset(1).Copy Workbooks("Uitvoer.xlsb").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .AutoFilter 1
  End With
End Sub
 
Thanks!
Hiermee is mijn eerste probleem al zeker opgelost.

Nog 1 issue: als er in rij 1 en 2 gegevens ingevuld staan, in rij 3 en 4 niet, en in rij 5 wel terug gegevens staan, dan zou ik nog een manier moeten vinden om enkel rij 1, 2 en 5 te kopiëren. Met de gegeven code lukt dat niet, merk ik.
 
Wat moet je met lege rijen in een tabel? De formules zijn niet correct doorgetrokken. In A4 staat
PHP:
=IF(ISBLANK(Eenmalig!$A4);"";Eenmalig!$A4)
In A5 staat
PHP:
=IF(ISBLANK(Eenmalig!$A6);"";Eenmalig!$A6)

Bij mij werkt de code wel met lege rijen ertussen. Er moet wel wat in kolom A staan want daar wordt op gefilterd.
 
inderdaad een fout van mij...
De code werkt correct!

Heel veel dank voor de hulp!
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan