Sub hypotheek_overnemen()
'Declareer de te gebruiken variabelen
Dim x As Integer
Dim legeregel As Long
Dim c As Range
Dim y As Long
Dim zoekterm, Totalen
'Vul hier je Array met de namen waarvan je een totaalblad wil maken.
'Voorbeeld: je hebt blad: "totalen berkman" dan vul je hier "berkman" in
Totalen = Array("hypotheek", "alternate")
'Eerste locatie in array is 0 (geen 1 zoals je zou denken)
'we vullen onze variabele y met het eerste woord uit de array
y = 0
'**********************************************************
'Vanaf hier gaan we de gegevens doorzoeken en over zetten
'**********************************************************
'eerste geven we het aantal elementen in de array aan zodat we niet blijven zoeken naar bladen welke er niet zijn.
'Verander de 2 in de hoeveelheid welke je in je array hebt
Do While y < 2
'Vul de zoekterm met de array inhoud
'zodat we met de zoekterm verder kunnen werken in het blad
zoekterm = Totalen(y)
'Maak het bereik op het blad leeg waarop we invoegen
'dit is standaard vanaf B8 tm E + de laatste gevulde rij
'met de code: Sheets("totalen " & zoekterm).Range("B65536").End(xlUp).Row bepalen we de laatst gevulde rij
Sheets("totalen " & zoekterm).Range("B8:E" & Sheets("totalen " & zoekterm).Range("B65536").End(xlUp).Row).ClearContents
'Hier gaan we door de maanden heen lopen, van 1 = jan tm 12 = dec
For x = 1 To 12
'nu gaan we door de tabbladen lopen
'voor ieder tabblad in deze excel file
For Each ws In Worksheets
'als de tabbladnaam de naam van maand x heeft voer dan de volgende code uit.
'hierin heeft x de naam van de maand welke we met For x=1 to 12 hebben gekregen
'de maandnaam wordt omgezet met bhv de zelf gemaakte functie Maandnaam zodat deze ook werkt op nederlandse windows systemen.
If ws.Name = Maandnaam(x) Then
'Zoek in het bereik B7:B150 op blad met de maandnaam
With Worksheets(ws.Name).Range("B7:B150")
'zoek de eerste cel met de inhoud van de zoekterm
Set c = .Find(zoekterm, LookIn:=xlValues)
'als er een cel is welke niet leeg is voer dan de code verder uit
If Not c Is Nothing Then
'vul de variabele firstAdress met het cel adres van de cel met de 1e gevonden zoekterm
firstAddress = c.Address
'zoek zolang er een cel met de zoekterm is welke niet als 1e gevonden is.
Do
'zoek de 1e lege regel op het blad totalen welke overeenkomt met de zoekterm
legeregel = Sheets("totalen " & zoekterm).Range("B65536").End(xlUp).Row + 1
'kopieer de gevonden cel met de 6 cellen ernaast (zie Resize) naar de legeregel.
Sheets(ws.Name).Range("B" & c.Row).Resize(1, 6).Copy Sheets("totalen " & zoekterm).Range("B" & legeregel)
'Vul de zoekvariabele met de volgende cel welke de zoekterm als inhoud heeft
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End If
Next
Next
'Verhoog y zodat we de volgende naam in de array door de loop halen
y = y + 1
'Volgende y plaatsen in de zoekterm
Loop
End Sub
Function Maandnaam(mnd As Integer) As String
'**************************************
'Credits functie gaan naar Wigi
'http://www.wimgielis.be
'**************************************
Select Case mnd
Case 1: Maandnaam = "januari"
Case 2: Maandnaam = "februari"
Case 3: Maandnaam = "maart"
Case 4: Maandnaam = "april"
Case 5: Maandnaam = "mei"
Case 6: Maandnaam = "juni"
Case 7: Maandnaam = "juli"
Case 8: Maandnaam = "augustus"
Case 9: Maandnaam = "september"
Case 10: Maandnaam = "oktober"
Case 11: Maandnaam = "november"
Case 12: Maandnaam = "december"
End Select
End Function
, voor de nl functie.
