• 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 overnemen op andere tabblad

Status
Niet open voor verdere reacties.

remco1987

Gebruiker
Lid geworden
22 jan 2014
Berichten
92
Is het mogelijk dat de "ingrediënten" van een product in Sheet Product komt zodat ik een omschrijving kan maken hoe het product gemaakt wordt?

kan dit automatisch of door een macro of door een prodcode aan te geven?
van de week ben ik geholpen met mijn FoodData daarvoor iedereen bedankt!
wie weet willen jullie mij weer helpen.

ik heb nu een macro knop gebruikt bij sheet "Recepten", echter verdwijnen de laatste regels ....maar wie weet, weten jullie een betere oplossing

Vriendelijke groet
Remco


Edit: heb zelf een macro toegepast maar ik krijg een error. Fout 91

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [b2:b1000]) Is Nothing Then
If Target.Count = 1 Then
With Sheets("PRODUCT")
Set prod = .[b2:b1000].Find(Target.Value)
End With
With Target
.Offset(, -1) = prod.Row
.Offset(-1, 0) = prod.Offset(-1).Value
.Offset(1, 0).Resize(22, 4) = prod.Offset(-1, 0).Resize(22, 4).Value
End With
End If
End If
End Sub
 

Bijlagen

  • demo versie KG VERSIE 2 (2).xlsm
    114,1 KB · Weergaven: 21
Laatst bewerkt:
Ik zie de Sub die je plaatste nergens in je document.
 
Ik zal er even naar kijken, maar heb je weleens van inspringpunten gehoord?
 
Ik zal er even naar kijken, maar heb je weleens van inspringpunten gehoord?

nee, ik ben helemaal geen expert, bestand met formules heb ik gemaakt door dr. youtube.
ik ga mij er eens in verdiepen, ben benieuwd! dankjewel
 
Ik heb er even naar gekeken en zo werkt het goed voor zover ik kan beoordelen:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
        If Target.Count = 1 Then
            With Sheets("PRODUCT")
                Set prod = .Range("B2:B1000").Find(Target.Value)
            End With
            
            With Target
                .Offset(, -1) = prod.Row
                .Offset(-1, 0) = prod.Offset(-1).Value
                .Offset(1, 0).Resize(22, 4) = prod.Offset(-1, 0).Resize(22, 4).Value
            End With
        End If
    End If
End Sub
 
Ik heb er even naar gekeken en zo werkt het goed voor zover ik kan beoordelen:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
        If Target.Count = 1 Then
            With Sheets("PRODUCT")
                Set prod = .Range("B2:B1000").Find(Target.Value)
            End With
            
            With Target
                .Offset(, -1) = prod.Row
                .Offset(-1, 0) = prod.Offset(-1).Value
                .Offset(1, 0).Resize(22, 4) = prod.Offset(-1, 0).Resize(22, 4).Value
            End With
        End If
    End If
End Sub

ik blijf helaas een foutcode krijgen nmr 91
 
Hier werkt het in je eigen document goed als ik sdw01 in cel B2 invul op het blad Recepten.
 
Dan denk ik dat je beter kan uitleggen wat je precies doet, in welke cel(len) en op welk tabblad.
 
Ik zal er even naar kijken, maar heb je weleens van inspringpunten gehoord?

ik wil als ik op de knop nieuw recept drukt alle cellen zoals a1 tm I32 het zelfde is maar dan een leeg document.
als ik dan in B34 een podcode invul hij de ingredienten en hoeveelheid met eenheid mee neemt van sheet Producten.
ofwel Sheet producten podcode: T01 vul ik in op sheet Recepten en hij haalt de gegevens op bij PRODUCTEN.
A57 tm C82.

hoop dat ik het zo goed heb uitgelegd?
 
heb nu het volgende maar krijg nog steeds een error


Private Sub CommandButton2_Click()
With Sheets("Recepten")
.Unprotect
x = [a100000].End(xlUp).Offset(1).Row
.Range("A1:I32").Copy Range("a" & x)
With Range("a" & x)
.Offset(, 1).Resize(3).ClearContents
.Offset(6).Resize(19, 3).ClearContents
End With
.Unprotect
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
If Target.Count = 1 Then
With Sheets("PRODUCT")
Set prod = .Range("B2:B1000").Find(Target.Value)
End With
With Target
.Offset(-1, 1) = prod.Row
.Offset(-1, 0) = prod.Offset(-1).Value
.Offset(-1, -1) = prod.Offset(-1, -1).Value
.Offset(1, -1).Resize(28, 3) = prod.Offset(1, -1).Resize(28, 3).Value
End With
End If
End If
End Sub
 
ik heb de code nu redelijk gekregen alleen plakt hij een nieuwe macro op de eerst volgende regel ipv vaste regel nmr 33

Private Sub CommandButton2_Click()
With Sheets("Recepten")
.Unprotect
x = [a100000].End(xlUp).Offset(1).Row
.Range("A1:I32").Copy Range("a" & x)
With Range("a" & x)
.Offset(, 1).Resize(5, 3).ClearContents
.Offset(6).Resize(31, 3).ClearContents
End With
.Unprotect
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
If Target.Count = 1 Then
With Sheets("PRODUCT")
Set prod = .Range("B2:B1000").Find(Target.Value)
End With
With Target
.Offset(-1, 1) = prod.Row
.Offset(-1, 0) = prod.Offset(-1).Value
.Offset(-1, -1) = prod.Offset(-1, -1).Value
.Offset(1, -1).Resize(32, 3) = prod.Offset(1, -1).Resize(32, 3).Value
End With
End If
End If
End Sub
 
probeer deze eens
 

Bijlagen

  • demo versie KG VERSIE 2 (2) (1) (3).xlsm
    123,1 KB · Weergaven: 13
probeer deze eens

ja super nu maakt doet hij de juiste cellen overnemen, dankjewel!

hij plaatst alleen de waardes niet zoals onderstaande hij geeft aan dat ik een fout heb bij offset-1, 1.
iemand een idee wat er fout gaat?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
If Target.Count = 1 Then
With Sheets("PRODUCT")
Set prod = .Range("B2:B1000").Find(Target.Value)
End With
With Target
.Offset(-1, 1) = prod.Row
.Offset(-1, 0) = prod.Offset(-1).Value
.Offset(-1, -1) = prod.Offset(-1, -1).Value
.Offset(1, -1).Resize(32, 3) = prod.Offset(1, -1).Resize(32, 3).Value
End With
End If
End If
End Sub
 
ja super nu maakt doet hij de juiste cellen overnemen, dankjewel!

hij plaatst alleen de waardes niet zoals onderstaande hij geeft aan dat ik een fout heb bij offset-1, 1.
iemand een idee wat er fout gaat?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
If Target.Count = 1 Then
With Sheets("PRODUCT")
Set prod = .Range("B2:B1000").Find(Target.Value)
End With
With Target
.Offset(-1, 1) = prod.Row
.Offset(-1, 0) = prod.Offset(-1).Value
.Offset(-1, -1) = prod.Offset(-1, -1).Value
.Offset(1, -1).Resize(32, 3) = prod.Offset(1, -1).Resize(32, 3).Value
End With
End If
End If
End Sub



ik krijg geen error in B2 wel in B34 etc.
 
ik blijf een error houden als ik een 2de recept wil invullen, iemand een idee?

voorwaarde is dat ik de prodcode moet invullen om alle gegevens op te halen uit PRODUCT
 

Bijlagen

  • demo versie KG VERSIE 2 (2) (1) (3).xlsm
    117,8 KB · Weergaven: 10
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan