gegevens tabblad 1 naar blad2 kopieren

[KeveinM]

Ik zou een macro willen schrijven, zodat wanneer ik op de knop 'Doorboeken' druk het volgende wordt uitgevoerd.

Tabblad 1 is een bestelbon waar in het gele gedeelte de artikels worden geplaatst.

Wanneer er bij 'aantal' (dus cel B13 tem B26') een cijfer staat moeten cel D3, A4, A13, B13 naar de eerstvolgende open regel in tabblad 2 gekopieerd worden.

D3 en A4 zijn steeds dezelfde waarde , A13 en B13 gaan tot A26 en B26 indien er een waarde in de B-kolom staat.

De macro die ik aan de knop toegewezen heb, kopieert enkel de laatste regel uit het gele gedeelte. Kan iemand mij helpen om elke regel in het gele gedeelte te kopieren?

Alvats bedankt

 

[VenA]

Zoiets?

Sub VenA()
Dim ar, j
With Sheets("Blad1")
    ar = .[A12].CurrentRegion.Offset(1)
    For j = 1 To UBound(ar)
        ar(j, 3) = ar(j, 1)
        ar(j, 4) = ar(j, 2)
        ar(j, 1) = .[e3]
        ar(j, 2) = .[B4]
    Next j
End With
    Sheets("Blad2").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(ar) - 1, 4) = ar
End Sub

 

[KeveinM]

VenA,

Inderdaad exact wat ik zoek! Bedankt voor de snelle reactie.


nog wel een kleine aanpassing in je code :

ar(j, 1) = .[e3] moet D3 worden
ar(j, 2) = .[B4] moet A4 worden

voor de rest is dit super!

Thx

 

[HSV]

Sub hsv()
Set sh = Sheets("Blad1")
With Sheets("Blad2").Cells(Rows.Count, 1).End(xlUp)
sn = sh.[a12].CurrentRegion.Offset(1).Resize(, 2)
  .Offset(1).Resize(UBound(sn) - 1, 2) = Array(sh.[d3], sh.[a4])
  .Offset(1, 2).Resize(UBound(sn) - 1, 2) = sn
End With
End Sub