• 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.

Creëren van tabblad gebaseerd op gegevens uit ander tabblad

Status
Niet open voor verdere reacties.
D

DimitriP2

Gebruiker
Lid geworden
10 feb 2020
Berichten
15
Beste,

Ik ben opzoek naar een VBA oplossing voor volgende probleem, zelf is mijn kennis van VBA veel te beperkt en weet ik dat er mogelijkheden zijn.
Zie bestand in bijlage.

Op tabblad "Bestellijst" is er een button voorzien "ceateManufactured List".
Wanneer er op deze knop gedrukt wordt moet tablblad "Manufactured list" moet volgende gebeuren
stap 1: Lijn 1 mag niet verwijderd worden, lijn A2:Jx moet worden verwijderd (x=aantal ingevulde lijnen) (deze regelt dient om bij wijzigingen de lijst te clearen en opnieuw te maken)
stap 2: Is de gegevens kopiëren van tabblad "bestellijst" naar "manufactured list" met behoudt van opmaak cel
Voorwaarde die voldaan moet worden om gegevens te kopiëren is waarde van cel = YES, inden de waarde No is dan moeten de gegevens uit deze lijn niet gekopieerd worden
Welke kolommen moeten worden gekopieerd voor de desbetreffende rij:
van tabblad "Bestellijst" kolom B naar tabblad "Manufactured list" kolom A
van tabblad "Bestellijst" kolom D naar tabblad "Manufactured list" kolom B
van tabblad "Bestellijst" kolom G naar tabblad "Manufactured list" kolom C
van tabblad "Bestellijst" kolom F naar tabblad "Manufactured list" kolom D
tabblad "Manufactured list" kolom E moet altijd worden ingevuld met "FirmaNaam"

Kunnen jullie me hierbij helpen?

Dank bij voorbaat,

Mvg,

Dimitri
 

Bijlagen

Code: 
Private Sub CommandButton1_Click()
Range("xfd1:xfd2") = Application.Transpose(Array(Cells(1).Value, "yes"))
With Sheets("manufactured list")
   .Cells(1).CurrentRegion.Offset(1).Clear
   Cells(1).CurrentRegion.AdvancedFilter 2, Range("xfd1:xfd2"), .Range("a1:e1")
   Range("xfd1:xfd2").ClearContents
End With
End Sub
 
Of zo
 

Bijlagen

Haije,

Dit werkt redelijk goed :-)
Alleen indien er een blanco cell staat in de de lijn van het tabblad "bestellijst" dan klopt de Manufactured list niet.
Dan schuiven de cellen in de kolom van het tabblad "Manufactured list" naar boven.

Is het makkelijk om de code aan te passen met een als-functie
vb als cell = blanco dan moet volgende waarde worden ingevuld "-" ?

Dan komen er geen blanco cellen meer te staan in de "Manufactured list" en staat alle informatie juist.

mvg

Dimitri
 
De andere al getest?
 
Alleen indien er een blanco cell staat in de de lijn van het tabblad "bestellijst" dan klopt de Manufactured list niet.
Klik om te vergroten...

Plaats eens een bestand waar dat in voorkomt
 
Dag Harry,

Ja ondertussen ook al uitgeprobeerd en werkt ook

mvg

Dimitri
 
Laatst bewerkt:
Haije zei:
Plaats eens een bestand waar dat in voorkomt
Klik om te vergroten...

Ik heb dat probleem kunnen oplossen met if funcite dat er een "-" waarde wordt ingevuld.

Maar in de uiteindelijke tabel gaat er nog een opmaak toegekend worden aan type van product.
Deze opmaakt zou moeten worden overgenomen (opmaak is een arcering)

Hoe kan deze code nog aangepast worden dat de opmaak ook mee overgenomen wordt
 
Hoi Dimitri,

dat is zo niet te zeggen. Hangt o.a. af van hoe de kleuren toegekend worden.

Als je een dergelijk voorbeeldbestand hebt dan (t.z.t.) plaatsen
 
Haije zei:
Hoi Dimitri,

dat is zo niet te zeggen. Hangt o.a. af van hoe de kleuren toegekend worden.

Als je een dergelijk voorbeeldbestand hebt dan (t.z.t.) plaatsen
Klik om te vergroten...

Eigenlijk vrij simpel, er gaat niet gewerkt worden met voorwaardelijke opmaak ofzo
- standaard delen krijgen geen opvulling (arcering)
- samenstelling krijgen een blauwe opvulling (arcering)

mvg

Dimitri
 
Plaats dan eens een voorbeeld waar dit in voorkomt...
 
Dimitri,

zo dan?
 

Bijlagen

Vreemde constructie om een sub in een andere module aan te roepen met een CommandButton.

Code: 
Private Sub CommandButton1_Click()
Range("xfd1:xfd2") = Application.Transpose(Array(Cells(1).Value, "yes"))
With Sheets("manufactured list")
   .Cells(1).CurrentRegion.Offset(1).Clear
   Cells(1).CurrentRegion.AdvancedFilter 2, Range("xfd1:xfd2"), .Range("a1:e1")
   .Range(.Cells(2, 5), .Cells(Rows.Count, 5).End(xlUp)) = "Firmanaam"
   Range("xfd1:xfd2").ClearContents
End With
End Sub
 
HSV zei:
Vreemde constructie om een sub in een andere module aan te roepen met een CommandButton.

Code: 
Private Sub CommandButton1_Click()
Range("xfd1:xfd2") = Application.Transpose(Array(Cells(1).Value, "yes"))
With Sheets("manufactured list")
   .Cells(1).CurrentRegion.Offset(1).Clear
   Cells(1).CurrentRegion.AdvancedFilter 2, Range("xfd1:xfd2"), .Range("a1:e1")
   .Range(.Cells(2, 5), .Cells(Rows.Count, 5).End(xlUp)) = "Firmanaam"
   Range("xfd1:xfd2").ClearContents
End With
End Sub
Klik om te vergroten...

De code werkt behoorlijk goed :cool:
Maar ik ben echt een leek in vba, in het uiteindelijke document moet er nog wat informatie toegevoegd worden in de eerste 2 lijnen waardoor er nu een bug zit in de formule.
Zie doc in bijlage. (heb ik uw code toegevoegd en 2 lijnen bij gevoegd)

Als deze bug eruit is dan werkt het perfect.

mvg

Dimitri
 

Bijlagen

Geen idee wat mensen bezielt met lege regels boven de gegevens.
Code: 
Private Sub CommandButton1_Click()
Range("xfd1:xfd2") = Application.Transpose(Array(Cells(3, 1).Value, "yes"))
With Sheets("manufactured list")
   .Cells(3, 1).CurrentRegion.Offset(1).Clear
   Cells(3, 1).CurrentRegion.AdvancedFilter 2, Range("xfd1:xfd2"), .Range("a3:e3")
   .Range(.Cells(4, 5), .Cells(Rows.Count, 5).End(xlUp)) = "Firmanaam"
   Range("xfd1:xfd2").ClearContents
End With
End Sub
Ps. Bij het gebruik van een Tabel heb je in codes geen last van steeds wisselende gedachtes.
 
Laatst bewerkt:
DimitriP2 zei:
De code werkt behoorlijk goed :cool:
Maar ik ben echt een leek in vba, in het uiteindelijke document moet er nog wat informatie toegevoegd worden in de eerste 2 lijnen waardoor er nu een bug zit in de formule.
Zie doc in bijlage. (heb ik uw code toegevoegd en 2 lijnen bij gevoegd)

Als deze bug eruit is dan werkt het perfect.

mvg

Dimitri
Klik om te vergroten...

De lege regels boven de tabel komen nog gegevens te staan zoals Project nummer, naam, verkoper, ontwikkelaar, verantwoordelijk aankoop, klant, .....
Dit zijn geen lege cellen.

De code werkt perfect indien deze cellen leeg zijn maar indien er een waarde instaat loopt deze vast.

Zie file in bijlage.

Mvg

Dimitri
 

Bijlagen

Bij deze.
Code: 
Private Sub CommandButton1_Click()
Range("xfd1:xfd2") = Application.Transpose(Array(Cells(3, 1).Value, "yes"))
With Sheets("manufactured list")
   .Cells(1).CurrentRegion.Offset(3).Clear
   Cells(1).CurrentRegion.Offset(2).AdvancedFilter 2, Range("xfd1:xfd2"), .Range("a3:e3")
   .Range(.Cells(4, 5), .Cells(Rows.Count, 5).End(xlUp)) = "Firmanaam"
   Range("xfd1:xfd2").ClearContents
End With
End Sub
 
HSV zei:
Bij deze.
Code: 
Private Sub CommandButton1_Click()
Range("xfd1:xfd2") = Application.Transpose(Array(Cells(3, 1).Value, "yes"))
With Sheets("manufactured list")
   .Cells(1).CurrentRegion.Offset(3).Clear
   Cells(1).CurrentRegion.Offset(2).AdvancedFilter 2, Range("xfd1:xfd2"), .Range("a3:e3")
   .Range(.Cells(4, 5), .Cells(Rows.Count, 5).End(xlUp)) = "Firmanaam"
   Range("xfd1:xfd2").ClearContents
End With
End Sub
Klik om te vergroten...

Deze code werkt schitterend, maar ik heb deze nu gekopieerd naar een ander document (zie document in bijlage) maar daar krijg ik volgende foutcode:
foutcode.png

Er is hier een kolom extra dus heb de code aangepast naar:

HSV zei:
Bij deze.
Code: 
Private Sub CommandButton1_Click()
Range("xfd1:xfd2") = Application.Transpose(Array(Cells(3, 1).Value, "yes"))
With [B][I][U]Sheets("SpareWear")[/U][/I][/B]
   .Cells(1).CurrentRegion.Offset(3).Clear
   Cells(1).CurrentRegion.Offset(2).AdvancedFilter 2, Range("xfd1:xfd2"), .Range([B][I][U]"a3:f3"[/U][/I][/B])
   .Range(.Cells(4,[U][I][B] 6[/B][/I][/U]), .Cells(Rows.Count, [B][I][U]6[/U][/I][/B]).End(xlUp)) = "Firmanaam"
   Range("xfd1:xfd2").ClearContents
End With
End Sub
Klik om te vergroten...
 

Bijlagen

Klik op de knop 'Reageer op bericht" i.p.v. het quoten van mijn berichten.

Ik schreef al eerder dat je beter Listobjecten (tabellen) kunt gebruiken, die hebben een range en databodyrange en sluiten andere cellen buiten.

Code: 
Private Sub MakeSpareWear_Click()
Range("xfd1:xfd2") = Application.Transpose(Array(Cells(3, 1).Value, "YES"))
    With Sheets("SpareWear")
       .Cells(3, 1).CurrentRegion.Offset(3).Clear
       Cells(3, 1).CurrentRegion.Offset(2).AdvancedFilter 2, Range("xfd1:xfd2"), .Range("a3:f3")
       .Range(.Cells(4, 6), .Cells(Rows.Count, 1).End(xlUp).Offset(, 5)) = "Firmanaam"
       Range("xfd1:xfd2").ClearContents
    End With
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan