VBA verkleinen en werkt niet altijd

[bar88]

Ik heb een VBA code, geschreven op mijn manier , maar hij werk niet altijd doordat hij stukken overslaat.
Op deze manier heb ik 25 invul cellen van B3 tm B26 die hij moet controleren.

Kan dit verkleint worden zodat hij geen regels meer overslaat of moet ik dit geheel anders schrijven?

  '7 van 26 invullen naar blad2
 Select Case Range("B7")
    Case "D"
    Sheets("Blad3").Range("A7").Copy
    Sheets("Blad2").Range("D65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    Case "M"
    Case "A"
    Case "B"
    Case "DHW"
    Case "HD"
    Case "C"
    Case "B"
 End Select
 
 Select Case Range("B7")
    Case "BOA"
    Case "R"
    Case "RV"
    Case "T"
    Case "0"
    Sheets("Blad3").Range("A7").Copy
    Sheets("Blad2").Range("M65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
 End Select
 
 Select Case Range("B7")
    Case "Z"
    Sheets("Blad3").Range("A7").Copy
    Sheets("Blad2").Range("U65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
 End Select

 

[sylvester-ponte]

ik heb een hoop fantasie , een voorbeeld bestandje graag

 

[JEC.]

Ik denk dat je even een voorbeeldbestandje moet plaatsen waarin je duidelijk maakt wat er moet gebeuren.
Ook met wat gewenste uitkomsten

 

[edmoor]

Voor wat je nu laat zien in gebruik te hebben is dit voldoende:

[COLOR="#008000"]'7 van 26 invullen naar blad2[/COLOR]
Sheets("Blad3").Range("A7").Copy
Select Case Range("B7")
   Case "D"
       Sheets("Blad2").Range("D65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
   Case "0"
       Sheets("Blad2").Range("M65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
   Case "Z"
       Sheets("Blad2").Range("U65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End Select

Maar doe vooral wat JVeer zegt.

 

[bar88]

Blad 3 wordt ingeladen door een ander excel bestand.
Hij moet dan in colom A zoeken naar de datum van vandaag (let op komt vanuit een andere excel lijst, hij ziet het dan niet als datum, dit lukt mij ook nog niet).
Als hij de datum ziet dan moet hij de namen in de juiste kolom zetten in het overzicht zodat je direct kan zien wie er aanwezig is en wie niet.

Ik heb het even in het klein gemaakt, knop werkt niet maar hoop dat je ziet wat de bedoeling is.

 

[JEC.]

Door de opzet van je bestand een matrix formule, die je moet afsluiten met control shift enter (als je geen office 365 hebt).
Formules staan in de grijze kolommen.

 

[bar88]

Ik krijg het niet voor elkaar. Alles staat nu als aanwezig.

 

[sylvester-ponte]

bar, bij mij werkt het prima, experimenteer eens met de datums

 

[bar88]

Ik probeer het anders, want het werkt helaas niet bij mij.

Als ik onderstaande doe dan slaat hij de voorwaarde over.
Als ik hem inkort dan werkt hij wel perfect. Er moeten eigenlijk nog meer voorwaardes erbij.
Kan het anders geschreven woorden waardoor hij wel alles pakt?
dit is "3 invullen naar blad2"
Dit gaat door naar 25

'3 invullen naar blad2
Sheets("Blad3").Range("A3:B3").Copy
Select Case Sheets("Blad3").Range("B3")
   Case ("M")
   Case ("A")
   Case ("DHW")
   Case ("B")
   Case ("D")
   Case ("M")
   Case ("HD")
   Case ("AKTIE")
       Sheets("Blad2").Range("D65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
   Case ("0")
   Case ("RV")
   Case ("V")
   Case ("BOA")
   Case ("EX")
       Sheets("Blad2").Range("M65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
   Case ("Z")
       Sheets("Blad2").Range("U65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End Select

 

[JEC.]

Heb je de formule afgesloten met control shift enter? Je ziet alle namen omdat de data op je eerste tabblad bij iedere naam hetzelfde is

 

[bar88]

Ja dat heb ik geprobeerd en ik heb achter de namen alles veranderd.
Het is de bedoeling dat ik hier een loop inmaakt zodat het straks op een tv te zien is.
Hierna komt een andere sheet met andere tekst en dat draait dan de gehele dag door.
Op het manier hier boven gaat dat, in mijn inzicht, niet werken.
Zo staat de naam "Bertus" bij Aanwezig, Afwezig en ziek.

 

[bar88]

If Range("B3") = ("D") Then 
    Sheets("Blad3").Range("A3:B3").Copy
    Sheets("Blad2").Range("D65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End If

Is het niet mogelijk dat in de zin

If Range("B3") = "D" Then

meerdere opties komt te staan bv, helaas werkt dit niet

If Range("B3") = ("D") or ("N") or ("DHW") Then

 

[sylvester-ponte]

bar, vul je bestandje eens een stukje in zoals je het wilt hebben (met de hand) en plaats hem dan op nieuw.
geef ook aan met welke versie van excel je werkt .
misschien kun je hier iets mee:

Select Case Range("Blad3!B3")
    Case "D", "M", "A", "B"
        'hier zet je jouw code
    Case "RV", "EX"
        'hier zet je jouw code
    Case "Z"
        'hier zet je jouw code
    Case Else
        'hier zet je jouw code
End Select

 

[bar88]

Ja dit werkt, bedankt.

HEEL ERG BEDANKT !!!! :thumb: