probleem met zoekrij ééntje opschuiven

[taco86]

ik heb hier een macro die elke keer een rij lager zou moeten pakken om vervolgens de tekst in die cel ergens anders naartoe te kopiëren. nu werkt om de één of andere reden excel niet helemaal zoals ik dat wil, het probleem is namelijk dat excel de waarde de eerste keer uit cel 8 pakt, de tweede keer uit cel 9, maar ook weer die uit c8 en de 3de keer dan uit cel 10, maar ook die uit cel 8 en 9, om al die onzinnige dubbele regels te voorkomen wil ik dus dat excel alleen de laatste cel pakt. Dit is de macro:

Sub WegSchrijven()
Dim izoekrij As Integer
izoekrij = 8
While Worksheets("Database").Cells(izoekrij, "B") <> ""
With Worksheets("Voorblad").Range("E1:K1")
Set pr = .Find(Worksheets("Database").Cells(izoekrij, "B"), LookIn:=xlValues)
If Not pr Is Nothing Then
Worksheets("Voorblad").Cells(Worksheets("Voorblad").Cells(65536, pr.Column).End(xlUp).Row + 1, pr.Column) = Worksheets("Database").Cells(izoekrij, "C")
End If
izoekrij = izoekrij + 1
End With


Wend

End Sub

 

[Roncancio]

Sub WegSchrijven()
Dim izoekrij As Integer
izoekrij = [B]Worksheets("Database").Cells(8, "B").End(xlDown).Row[/B]
While Worksheets("Database").Cells(izoekrij, "B") <> ""
With Worksheets("Voorblad").Range("E1:K1")
Set pr = .Find(Worksheets("Database").Cells(izoekrij, "B"), LookIn:=xlValues)
If Not pr Is Nothing Then
Worksheets("Voorblad").Cells(Worksheets("Voorblad").Cells(65536, pr.Column).End(xlUp).Row + 1, pr.Column) = Worksheets("Database").Cells(izoekrij, "C")
End If
izoekrij = izoekrij + 1
End With

Met vriendelijke groet,


Roncancio