Beste iedereen,
Wederom een vraag van mij.. Ik probeer een bestelformulier op te stellen, met op de eerste sheet het "bestellformular". En op de andere sheets de categorieën waarin producten te bestellen zijn. Per tab/categorie kan men achter het product aangeven hoe vaak zij deze wensen te ontvangen. Wanneer men dan terug naar het bestelformulier gaat en dan op de knop "updaten formulier" drukt, had ik graag dat alle producten waar een aantal bij is aangegeven gekopieerd wordt naar de sheet "bestellformular".
Momenteel is dit mijn VBA code
Mijn excuses als het wat rommelig oogt/is.
Het probleem: hij kiest artikelen en kopieert die naar de eerste sheet, weliswaar alleen artikelen met een aantal erachter. Maar hij pakt van de ene sheet 2 artikelen, terwijl er bij 4 een aantal staan en bij de andere sheet geen artikelen terwijl er achter 3 een aantal staat. Hij pakt wel telkens dezelfde artikelen.
Is er iemand die ziet wat ik fout heb gedaan?
Wederom bedankt,
Eva
Bekijk bijlage Bestelformular.xlsm
Wederom een vraag van mij.. Ik probeer een bestelformulier op te stellen, met op de eerste sheet het "bestellformular". En op de andere sheets de categorieën waarin producten te bestellen zijn. Per tab/categorie kan men achter het product aangeven hoe vaak zij deze wensen te ontvangen. Wanneer men dan terug naar het bestelformulier gaat en dan op de knop "updaten formulier" drukt, had ik graag dat alle producten waar een aantal bij is aangegeven gekopieerd wordt naar de sheet "bestellformular".
Momenteel is dit mijn VBA code
Mijn excuses als het wat rommelig oogt/is.
Code:
Private Sub CommandButton1_Click()
Dim LastRow As Long
Dim i As Long, j As Long
'zoekt laatste row
With Worksheets("Übriger")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Worksheets("Darmbakterien")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Worksheets("Intestinum aufbauschutz")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Worksheets("Verdauungsenzyme")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Worksheets("Leber Entgiftung Dysbiose Infla")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Worksheets("Stress regulierung vitamin b km")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Worksheets("Mineralien")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'terugkoppeling naar bestelform
With Worksheets("Bestellformular")
j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
'kopieren naar bestelform
For i = 2 To LastRow
With Worksheets("Übriger")
If .Cells(i, 11).Value >= 1 Then
.Rows(i).Copy Destination:=Worksheets("Bestellformular").Range("A" & j)
j = j + 1
End If
End With
With Worksheets("Darmbakterien")
If .Cells(i, 11).Value >= 1 Then
.Rows(i).Copy Destination:=Worksheets("Bestellformular").Range("A" & j)
j = j + 1
End If
End With
With Worksheets("Intestinum aufbauschutz")
If .Cells(i, 11).Value >= 1 Then
.Rows(i).Copy Destination:=Worksheets("Bestellformular").Range("A" & j)
j = j + 1
End If
End With
With Worksheets("Verdauungsenzyme")
If .Cells(i, 11).Value >= 1 Then
.Rows(i).Copy Destination:=Worksheets("Bestellformular").Range("A" & j)
j = j + 1
End If
End With
With Worksheets("Leber Entgiftung Dysbiose Infla")
If .Cells(i, 11).Value >= 1 Then
.Rows(i).Copy Destination:=Worksheets("Bestellformular").Range("A" & j)
j = j + 1
End If
End With
With Worksheets("Stress regulierung vitamin b km")
If .Cells(i, 11).Value >= 1 Then
.Rows(i).Copy Destination:=Worksheets("Bestellformular").Range("A" & j)
j = j + 1
End If
End With
With Worksheets("Mineralien")
If .Cells(i, 11).Value >= 1 Then
.Rows(i).Copy Destination:=Worksheets("Bestellformular").Range("A" & j)
j = j + 1
End If
End With
Next i
End Sub
Het probleem: hij kiest artikelen en kopieert die naar de eerste sheet, weliswaar alleen artikelen met een aantal erachter. Maar hij pakt van de ene sheet 2 artikelen, terwijl er bij 4 een aantal staan en bij de andere sheet geen artikelen terwijl er achter 3 een aantal staat. Hij pakt wel telkens dezelfde artikelen.
Is er iemand die ziet wat ik fout heb gedaan?
Wederom bedankt,
Eva
Bekijk bijlage Bestelformular.xlsm