gegevens van een ander blad valideren

[LucB]

Guido,

Staat de formule nog in H3.
Zo ja, kijk dan even op Extra-Opties-Berekenen.
Zet Berekenen op Automatisch.

 

[Bosch_Guido]

Beste Luc,

de code werkt helemaal super. Bedankt! Nu heb ik alleen een volgend (klein) probleempje. ik probeer de code nu toe te passen op een andere selectie, maar de waarde wordt constant alleen in "O2" gezet. Hij lijkt dus geen x meer te tellen. Heb je enig idee hoe dit kan?

Hier de code:

Option Explicit
Sub kopieren_faciliteiten1()
Application.ScreenUpdating = False
Dim d As Variant
Dim x As Long

With Sheets("Bezoekers_en_tarieven")
x = Cells(Rows.Count, "O").End(xlUp).Row
End With
With ActiveSheet
If Range("I37") = True Then
Range("A37").Copy Destination:=Sheets("Bezoekers_en_tarieven").Range("O" & x).Offset(1, 0)
Else
For Each d In Sheets("Bezoekers_en_tarieven").Range("O4:O100")
If d = Range("A37").Value Then
d.Delete Shift:=xlUp
End If
Next d
End If
End With
Application.ScreenUpdating = True
End Sub

Sub kopieren_faciliteiten2()
Application.ScreenUpdating = False
Dim d As Variant
Dim x As Long

With Sheets("Bezoekers_en_tarieven")
x = Cells(Rows.Count, "O").End(xlUp).Row
End With
With ActiveSheet
If Range("I38") = True Then
Range("A38").Copy Destination:=Sheets("Bezoekers_en_tarieven").Range("O" & x).Offset(1, 0)
Else
For Each d In Sheets("Bezoekers_en_tarieven").Range("O4:O100")
If d = Range("A38").Value Then
d.Delete Shift:=xlUp
End If
Next d
End If
End With
Application.ScreenUpdating = True
End Sub

Ik hoop dat je me nog één keer kunt helpen!
Het liefst zou ik eigenlijk de waarden direct naar de cellen B69 tot B83 kopieren, maar dan kom ik in de knoei met de Count, want ik kan volgens mij niet tellen in een bepaalde range, of wel?

Guido

Bedankt

 

[LucB]

Guido,

Zet een tekst in O3.

 

[Bosch_Guido]

kun je me ook vertellen waarom? Want dan kan ik wellicht ook naar andere cellen kopieren als ik de range ("O4:O100") verander?

 

[Bosch_Guido]

Het werkt trouwens NIET. :S Ik snap er niks van...

 

[LucB]

Guido,

Ik snap hier ook niks van.
Nog even geduld.

 

[Bosch_Guido]

Luc,

Weet je wel waarom ik een waarde in O3 zou moeten zetten? Want ik heb inmiddels wel een gedeelte werkend.... Ik weet zo gauw niet meer wat ik verandert heb. Ik krijg nu de eerste waarde in O69, zoals ik het wil. In O68 heb ik een tekst staan.
Hierbij de code:

Sub kopieren_faciliteiten1()
Application.ScreenUpdating = False
Dim d As Variant
Dim x As Long

With Sheets("Bezoekers_en_tarieven")
x = .Cells(Rows.Count, "O").End(xlUp).Row
End With
With ActiveSheet
If Range("I37") = True Then
Range("A37").Copy Destination:=Sheets("Bezoekers_en_tarieven").Range("O" & x).Offset(1, 0)

Else
For Each d In Sheets("Bezoekers_en_tarieven").Range("O69:O100")
If d = Range("A37").Value Then
d.Delete Shift:=xlUp
End If
Next d
End If
End With
Application.ScreenUpdating = True
End Sub

Sub kopieren_faciliteiten2()
Application.ScreenUpdating = False
Dim d As Variant
Dim x As Long

With Sheets("Bezoekers_en_tarieven")
x = .Cells(Rows.Count, "O").End(xlUp).Row
End With
With ActiveSheet
If Range("I38") = True Then
Range("A38").Copy Destination:=Sheets("Bezoekers_en_tarieven").Range("O" & x).Offset(1, 0)

Else
For Each d In Sheets("Bezoekers_en_tarieven").Range("O69:O100")
If d = Range("A38").Value Then
d.Delete Shift:=xlUp
End If
Next d
End If
End With
Application.ScreenUpdating = True
End Sub

Sub kopieren_faciliteiten3()
Application.ScreenUpdating = False
Dim d As Variant
Dim x As Long

With Sheets("Bezoekers_en_tarieven")
x = .Cells(Rows.Count, "O").End(xlUp).Row
End With
With ActiveSheet
If Range("I39") = True Then
Range("A39").Copy Destination:=Sheets("Bezoekers_en_tarieven").Range("O" & x).Offset(1, 0)

Else
For Each d In Sheets("Bezoekers_en_tarieven").Range("O69:O100")
If d = Range("A39").Value Then
d.Delete Shift:=xlUp
End If
Next d
End If
End With
Application.ScreenUpdating = True
End Sub
Sub kopieren_faciliteiten4()
Application.ScreenUpdating = False
Dim d As Variant
Dim x As Long

With Sheets("Bezoekers_en_tarieven")
x = .Cells(Rows.Count, "O").End(xlUp).Row
End With
With ActiveSheet
If Range("I40") = True Then
Range("A40").Copy Destination:=Sheets("Bezoekers_en_tarieven").Range("O" & x).Offset(1, 0)

Else
For Each d In Sheets("Bezoekers_en_tarieven").Range("O69:O100")
If d = Range("A40").Value Then
d.Delete Shift:=xlUp
End If
Next d
End If
End With
Application.ScreenUpdating = True
End Sub
Sub kopieren_faciliteiten5()
Application.ScreenUpdating = False
Dim d As Variant
Dim x As Long

With Sheets("Bezoekers_en_tarieven")
x = .Cells(Rows.Count, "O").End(xlUp).Row
End With
With ActiveSheet
If Range("I41") = True Then
Range("A41").Copy Destination:=Sheets("Bezoekers_en_tarieven").Range("O" & x).Offset(1, 0)

Else
For Each d In Sheets("Bezoekers_en_tarieven").Range("O69:O100")
If d = Range("A41").Value Then
d.Delete Shift:=xlUp
End If
Next d
End If
End With
Application.ScreenUpdating = True
End Sub

Guido

 

[LucB]

Guido,

Eerst het antwoord op je voorlaatste probleem.
Ik heb de macro's veranderd. Zie module9 en het werkt.
Wil je dit eerst even afwerken.

 

[LucB]

Guido,

x = .Cells(Rows.Count, "O").End(xlUp).Row

Er wordt gekeken in kolom O vanonderenop

Ven de 1e cel die hij dan tegen komt legt hij het rijnummer vast. Dat is in dit geval de cel met de tekst.

en met Offset(1, 0) wordt de gekopieerde waarde 1 cel naar beneden en 0 cellen opzij geplakt.

Dus staat je tekst in O3 , wordt er geplakt in O4.

Bij volgende kopieer-actie komt hij dus het eerst O4 tegen en plakt dan in O5 enz enz..

 

[Bosch_Guido]

Luc,

erg bedankt voor je hulp. Ik heb er veel aan gehad. Misschien dat ik nog tegen een volgend probleem aanloop, dan zal ik graag weer een beroep op jou/dit forum doen. Bedankt! :thumb:

Guido