VBA Hulp

[John van Opstal]

Wie kan mij helpen...
Ik heb een voorbeeldbestandje met daarin een lijstje met werkzaamheden en in de rijen van dat lijstje komt een "x" te staan op de dag dat de werkzaamheden gebeuren moeten.

Nu wil ik graag de rijen die een "x" bevatten d.m.v. VBA selekteren, en netjes onder elkaar naar een ander werkblad [Blad2]kopieren en plakken [als.waarde].
In [Blad2] worden regelmatig rijen ingevoegd, verwijdert en gekopieerd dus de actieve cel in Blad 2 wil ik kunnen kiezen voordat de gegevens geplakt worden.

Ik ben een beginneling met VBA, een For...Next loopje om de "x" de vinden heb ik gemaakt, maar ik krijg het maar niet voor elkaar om de rijen waarin de "x"jes staan te selecteren,e.d., wel e.e.a. geprobeerd met If...Then...

Beetje bij beetje hoop ik via jullie mijn VBA kennis op te krikken.
Misschien wordt ik ook nog eens een mega senior als Wigi.

Groetjes John.

Groetjes John

 

[Wigi]

Het kopieren naar blad 2 begrijp ik nog niet. Wat moet er komen? 5 kolommen of 4? Welke kolommen?

Waarom ook 2 tabellen in blad 2?

Denk wel dat wat je vraagt mogelijk is.

Wigi

 

[Wigi]

Tussen haakjes, gebruik dit voor de sortering:

Private Sub Worksheet_Change(ByVal Target As Range)
    Range("A1:E1", Range("A1:E1").End(xlDown)).Sort Key1:=Range("A2"), Order1:=xlDescending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G1").Select
End Sub

Ik wacht op verdere info voor de rest.

 

[John van Opstal]

Hoi Wigi,

Sorry Wigi, die twee tabellen op Blad2 ben ik gewoon vergeten weg te halen.
Blad2 mag gewoon leeg zijn...

Wat betreft jou vraag: Ik wil feitelijk alle rijen die een "x" bevatten in kolom 1, kopieren en
netje onder elkaar plakken als waarde in Blad2.
Omdat Blad2 in werkelijkheid nogal aan verandering onderhevig is wil ik graag in Blad2
op een cel gaan staan waarin voldoende ruimte is om de selectie te plakken.

Ik hoop dat dit iets duidelijker is.
Groetjes John.

 

[Wigi]

Hier is de code voor het kopiëren van de rijen met een "x".

Sub kopieren()
Dim aantal As Long
aantal = WorksheetFunction.CountIf(Range("A1:A10"), "x")
Worksheets("Blad1").Range("G1").Value = Worksheets("Blad1").Range("G1").Value
With Worksheets("Blad2")
    .Cells.ClearContents
    Range("A2:E" & aantal + 1).Copy
    .Range("A1").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End Sub

Wigi

 

[John van Opstal]

Bedankt Wigi,
Vanavond heb ik even tijd ga ik hem gelijk proberen.

Groetjes John