automatisch gegevens overnemen van tabblad

[remco1987]

Gda,

ik probeer in mijn bestand regels automatisch in te voeren zodat ik het tabblad FoodData in mijn data base kan krijgen.
alleen krijg ik het niet voor elkaar dat hij automatisch de gegevens opzoekt in mijn ingevoerde tabblad PRODUCT. zodra er een ProdName ingevoerd wordt in tab PRODUCT.

in de bijlage heb ik op beide tabbladen laten zien wat ik wil.
ik wil op tab PRODUCT recepten toe kunnen voegen (ik weet geen andere manier als regels kopieren en plakken)
en in de tab FoodData wil ik alle belangrijke cellen geplakt hebben.

ik hoop dat ik het een beetje goed uitgelegd hebt

Vriendelijke groet
Remco

 

[alphamax]

Denk eens over een andere opmaak die, door de samengevoegde cellen kan je een structuur die op een database lijkt wel vergeten.

 

[remco1987]

Denk eens over een andere opmaak die, door de samengevoegde cellen kan je een structuur die op een database lijkt wel vergeten.

ik heb een macro gemaakt alleen geeft hij een error aan. hij haalt de data dan uit diverse cellen. is het idee

 

[alphamax]

Plaats dan eens een bestand met de macro.
.xlsx-bestand kunnen geen macro bevatten, .xlsm-bestanden wel.

 

[remco1987]

Plaats dan eens een bestand met de macro.
.xlsx-bestand kunnen geen macro bevatten, .xlsm-bestanden wel.

scherp, nu met xlsm

 

[remco1987]

het is mij gelukt om gegevens over te dragen naar een andere tab dmv een macro.

nu haalt hij nog niet de juiste gegevens op, is er iemand die wat meer verstand met macro's heeft? (gaat al snel op een forum als deze)


Sub j()
With Sheets("PRODUCT")
lr = .Cells(1, 1).End(xlDown).Offset(1).Row
.Cells(lr, 1).Resize(, 20) = Array([B2], [B1], [G2], [B3], [G36], [G42], [G45], [G44], [G40], [G33])
End With
End Sub



Sub Beetje_Opzoekwerk()
With Sheets("PRODUCT") 'je werkblad
.UsedRange.Columns("A").Name = "Cake_Taart" 'gedefinieerde naam aanmaken
a = Filter([transpose(if(Cake_Taart="Prodname:",row(cake_taart),"~"))], "~", 0) 'array met het rijnummer van alle cellen waar "Prodname:" in staat
For i = 0 To UBound(a) 'loop al die cellen af
ReDim res(0 To 10) 'lege array met 10 posities voor het verzamelen van de gegevens
i1 = --a(i) 'zo'n rijnummer
If i <> UBound(a) Then i2 = --a(i + 1) Else i2 = .Range("A" & Rows.Count).End(xlUp).Row 'volgende rijnummer of anders laatste rij
arr = .Range("A" & i1).Resize(i2 - i1 + 1, 7).Value 'inlezen waarden van dat bereik van dat gerecht
kol1 = Application.Transpose(Application.Index(arr, 0, 1)) 'in de 1e kolom staan alle termen
res(0) = i1 'rijnummer in "cake en taarten"
res(1) = arr(2, 2) 'gerecht
res(2) = arr(1, 2) 'naam van het gerecht
If res(2) <> "" Then 'naam is ingevuld
zoektermen = Array("totale inslag", "aantal personen:", "inslag per persoon", "Verkoopprijs website", "Bruto Winst", "netto verkoopprijs", "BTW 9%", "vermenigvuldigingsfactor") 'waar moet je achtereenvolgens op zoeken
For i3 = 0 To UBound(zoektermen) 'alle zoektermen aflopen
r = Application.Match(zoektermen(i3), kol1, 0) 'rij binnen de array waar dat staat (indien gevonden)
If IsNumeric(r) Then res(3 + i3) = arr(r, IIf(i3 = 1, 2, 7)) 'gevonden waarde naar resultaten-array schrijven
Next

With Sheets("FoodData")
kol1 = Application.Transpose(.UsedRange.Columns(1)) 'kolom met rijnummers van "PRODUCT"
r = Application.Match(i1, kol1, 0) 'rij binnen de array waar dat staat (indien gevonden)
If Not IsNumeric(r) Then r = Application.Match(CStr(i1), kol1, 0) 'rij binnen de array waar dat staat (indien gevonden)
If Not IsNumeric(r) Then r = .Cells(Rows.Count, 2).End(xlUp).Offset(1).Row 'volgende lege rij
.Cells(r, 1).Resize(, UBound(res) + 1).Value = res 'wegschrijven van het zaakje
End With
End If
Next
End With
End Sub


in de bijlage het bestand en wat tekst er bij gedaan voor de uitleg
alle grijze vlakken moeten uit sheet PRODUCT komen.

gr Remco