macro

[Nuyts jan]

allen
in bijlage plaats ik een template van een offerte. Deze heeft 2 tabbladen OFFERTEARTIKELLIJST en ARTIKELLIJST. Op tabblad ARTIKELLIJST is er een filtering gemaakt in de kolom X. Na deze filtering zou ik graag de kolommen in het geel aangeduid willen kopiëren naar tabblad OFFERTEARTIKELLIJST vertrekkende van lijn 24 (zonder opmaak). Kan hier een macro van gemaakt worden.
Bekijk bijlage offerte.zip

 

[RvanGalenLast]

Beste Jan,

Onderstaand een code die alle regels gemarkeerd met "X" in het bestemde vak zet. Als eerste wordt het "offertevak" leeggemaakt en dan worden alle regels gekopiëerd. Wel moeten de aantallen er nog bijgezet worden. Hoop dat je er iets aan hebt.

Sub OfferteAanmaken()
Dim Lr As Integer, i As Integer, j As Integer
Dim ws1 As Worksheet, ws2 As Worksheet
Application.ScreenUpdating = False
    Set ws1 = Sheets("OFFERTEARTIKELLIJST")
    Set ws2 = Sheets("ARTIKELLIJST")
    ws1.Range("B24:E39,G24:G39").ClearContents
    Lr = ws2.[B65000].End(xlUp).Row
    j = 24
    For i = Lr To 6 Step -1
        With ws2
            If .Cells(i, 2) = "X" Then
                .Cells(i, 10).Copy
                    ws1.Cells(j, 2).PasteSpecial Paste:=xlPasteValues
                .Cells(i, 17).Copy
                    ws1.Cells(j, 3).PasteSpecial Paste:=xlPasteValues
                .Cells(i, 22).Copy
                    ws1.Cells(j, 7).PasteSpecial Paste:=xlPasteValues
            j = j + 1
            End If
        End With
    Next
Application.ScreenUpdating = True
End Sub

 

[Nuyts jan]

Ronald enorm bedankt hiervoor, het werkt van de 1ste keer.:thumb: grt Jan Nuyts