• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Cellen verplaatsen naar andere sheet.

Status
Niet open voor verdere reacties.
R

roschatz

Gebruiker
Lid geworden
10 okt 2008
Berichten
20
Goeden dag allemaal,

Ik zit met de volgende uitdaging.
Binnen een controle systeem die ik heb gemaakt wil ik graag 2 of meerdere cellen automatisch verplaatsen naar een andere sheet.
Dit om aan het einde van de dag te kunnen zien wat nog niet gecontroleerd is.
Nu heb ik iets gevonden op het forum alleen werkt dit niet hoe ik het wil hebben.

kan iemand mij helpen.

Het bovenste gedeelte had ik al het onderste gedeelte dik gedrukt heb ik op het forum gevonden.

Alvast bedankt.

Private Sub Worksheet_Change(ByVal Target As Range)

Select Case Target.Address

Case "$B$1": If Target.Value >= 1 Then Application.GoTo Range("A1")
Case "$A$1": If Target.Value >= 1 Then Application.GoTo Range("B1")

End Select
End Sub


Private Sub Worksheet_Calculate()
Dim oPic As Picture
Me.Pictures.Visible = False
With Range("C4")
For Each oPic In Me.Pictures
If oPic.Name = .Text Then
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
Exit For
End If
Next oPic
End With
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$10" Then 'het adres van de betreffende cel
Select Case Left(Target.Value, 1) 'check op het eerste cijfer van de invoer
Case 1
Target.Copy Sheets("1").Range("A65536").End(xlUp).Offset(1) 'eerstvolgende lege cel in kolom A
Case 2
Target.Copy Sheets("2").Range("A65536").End(xlUp).Offset(1)
Case 3
Target.Copy Sheets("3").Range("A65536").End(xlUp).Offset(1)
End Select
End If
End Sub
Klik om te vergroten...
 
Kijk eens; twee cellen van blad1 worden verplaatst naar blad2.
Code: 
sub hsv()
 sheets(1).range("a1:a2").cut sheets(2).range("a1")
end sub

...tenminste de inhoud.
 
Dan is mijn glazen bol stuk.
 
Natuurlijk werkt dat wel, net als het dik gedrukte stuk dat je plaatste.
Je zal het wel aan je eigen situatie moeten aanpassen.
Als lid sinds 2008 zou je toch moeten weten dat voor een correct antwoord op je vraag een relevant voorbeeld vereist is.
 
Je hebt gelijk een voorbeeld is misschien wel handig.
 

Bijlagen

  • voorbeeld verplaatsen.xlsx
    8,8 KB · Weergaven: 31
Ik ben er zelf uitgekomen.
De code die ik zocht is de volgende.


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" Then 'het adres van de betreffende cel
Select Case Left(Target.Value, 1) 'check op het eerste cijfer van de invoer
Case 1
Target.Copy Sheets("1").Range("A65536").End(xlUp).Offset(1) 'eerstvolgende lege cel in kolom A
Case 2
Target.Copy Sheets("2").Range("A65536").End(xlUp).Offset(1)
Case 3
Target.Copy Sheets("3").Range("A65536").End(xlUp).Offset(1)
End Select
End If

Select Case Target.Address

Case "$B$1": If Target.Value >= 1 Then Application.GoTo Sheets(2).Range("A1")
Case "$A$1": If Target.Value >= 1 Then Application.GoTo Sheets(2).Range("B1")
End Select

End Sub
Klik om te vergroten...
 
Ik kan mij niet voorstellen dat de code werkt in het voorbeeldbestand....

De eerste Select Case kan denk ik ook zo
Code: 
If Target.Address = "$B$1" Then Sheets(Left(Target.Value, 1)).Cells(Rows.Count, 1).End(xlUp).Offset(1) = Target.Value

Wat de tweede doet begrijp ik niet.
 
Zou ik er nog wel een controle inbouwen.
Code: 
If Target.Address = "$B$1" [COLOR=#0000ff]and left(target,1) < 4[/COLOR]
 
Dan zou ik het laten maken, het geeft een foutmelding bij bepaalde invoer. :p
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan