tussenliggende waardes in formule verwerekn middels macro

[Etienne1978]

Hallo,

Ik heb een bestand met in kolom a leeftijden varrierend van 18 t/m 65.
nu wil ik deze gaan splitsen in de catagorien 18-27 ; 27-40 ; 40-50; 50-60 ; 60-65
vervolgens moet catagorie 18-27 giknipt en geplakt woden naar blad 2 catagorie 27-40 naar blad 3 etc.

de formule die ik gebruik in mijn macro ziet er zo uit (alleen hij werkt niet).

Sub kopierenleeftijdjaren1()

Dim intaantalrijen As Integer
Dim i As Integer
Dim currentcell As Range

Range("a1").Select
intaantalrijen = ActiveCell.CurrentRegion.Rows.Count

For i = 1 To intaantalrijen
For Each currentcell In Selection.Cells
If currentcell.Value = ">= 18 and < 27" Then
currentcell.EntireRow.Cut
Sheets("blad2").Select
ActiveSheet.Paste
ActiveCell.Select
ActiveCell.Offset(1, 0).Select
End If

Sheets("blad1").Select
ActiveCell.Offset(1, 0).Select


Next currentcell
Next i

Voor de andere catagorien heb ik nog geen formule daar deze nog niet werkt.

Alvast bedankt voor de tips.

groet,
etienne


End Sub

 

[DJJochem]

Kun je niet een macro opnemen, en die dan laten uitvoeren???

 

[TomP]

Hej Etienne,

Op zich zat je met je macro goed in de buurt. Zie vba stuk hieronder. Dit heb ik gewijzigd:

- de "currentcell" moet je vervangen door activecell.
- een loop door de cellen heen is niet nodig (for each currentcell), omdat je steeds maar één cel selecteert.
- de manier waarop je de voorwaarde voor de leeftijden controleert is niet helemaal correct, vervangen naar: If ActiveCell.Value >= 18 And ActiveCell.Value < 27 Then
- Verder heb ik de 'cut' vervangen door 'copy', zodat de regels in je bronblad niet kwijt bent.

Deze macro werkt nu voor één leeftijdsgroep (18 tot 27). Probeer de macro zo te schrijven dat de leeftijdsondergrens,- en bovengrens variabel zijn, zodat je niet voor elke leeftijdsgroep een nieuwe macro hoeft te schrijven. Dit zou je bijvoorbeeld kunnen doen door in een tabblad een tabelletje te maken met drie kolommen: leeftijd_ondergrens, leeftijd_bovengrens, tabblad_naam (= voor elke leeftijdsgroep de naam van de tabblad). Middels een loop door dit tabelletje, kun je middels 1 macro alle leeftijdscategorieën verwerken....


Sub kopierenleeftijdjaren1()

Dim intaantalrijen As Integer
Dim i As Integer
Dim currentcell As Range

Range("a1").Select
intaantalrijen = ActiveCell.CurrentRegion.Rows.Count

For i = 1 To intaantalrijen





If ActiveCell.Value >= 18 And ActiveCell.Value < 27 Then
ActiveCell.EntireRow.Copy
Sheets("blad2").Select
ActiveSheet.Paste
ActiveCell.Select
ActiveCell.Offset(1, 0).Select
End If

Sheets("blad1").Select
ActiveCell.Offset(1, 0).Select


Next i
End Sub

Gr. Tom