Celinhoud kopieren door middel van 1 of 0 value in andere cel ! Help :(

[caresquare]

Dag beste mensen,

ik heb een opdracht te doen voor mijn stage,
deze opdracht is helemaal in excel, ik zal hem kort beschrijven.

Ik moet een Offerte opmaken waarbij de Producten automatisch in een lijst verschijnen, dus ik moet 2 werkbladen hebben. 1 voor de Producten en 1 voor de Offerte.

Op het Producten-werblad staan er 3 collumns, 1 voor de Producten naam, 1 voor de prijs, en 1 om aan te duiden of ik het product op mijn Offerte wil.
Dus als ik een 1 naast een bepaald product zet ( op het werkblad "Producten") ,
zou dit moeten terecht komen op mijn OfferteK

Helaas heb ik geen idee hoe dit moet. Ik ben al 5 uur aan het rondzoeken op internet, en vind niets. Ook geen handige templates op sites :s

Alvast bedankt om mij te helpen!

Bekijk bijlage helpmij.xls Als je het niet helemaal snapt, heb ik een bijlage geüpload Bekijk bijlage helpmij.xls

 

[caresquare]

Is er niemand online die mij kan helpen?

ik zit nu op mijn stage, en ik ben al heel lang bezig aan de opdracht,
ik heb al gezegt dat ik geen ervaring heb met excel, en toch moet ik het doen

 

[Haaren101]

Tsja, je zit ook al 8 hele minuten te wachten!

Ron

 

[caresquare]

Tsja, je zit ook al 8 hele minuten te wachten!

Ron

Ja dit is mijn laatste jaar, en wil niet gebuist zijn voor een probleem die hier misschien kan opgelost worden

Victor

 

[caresquare]

Nog altijd niemand?

 

[Warme bakkertje]

Om je ongeduld wat te bekoelen, de helpers hier doen dit vrijwillig en in hun vrije tijd, dus zitten niet echt te wachten totdat iemand een vraag post en zij onmiddelijk een antwoord kunnen bieden.

Sub tst()
    For Each cl In [Producten!C2:C11]
        If cl = 1 Then [offerte!A65536].End(xlUp).Offset(1).Resize(, 2) = _
                            cl.Offset(, -2).Resize(, 2).Value
    Next
End Sub

 

[caresquare]

Om je ongeduld wat te bekoelen, de helpers hier doen dit vrijwillig en in hun vrije tijd, dus zitten niet echt te wachten totdat iemand een vraag post en zij onmiddelijk een antwoord kunnen bieden.

Sub tst()
    For Each cl In [Producten!C2:C11]
        If cl = 1 Then [offerte!A65536].End(xlUp).Offset(1).Resize(, 2) = _
                            cl.Offset(, -2).Resize(, 2).Value
    Next
End Sub

Zou je me kunnen zeggen wat ik moet doen met deze code? ;<
ik weet namelijk bijna niets van excel ;s

 

[caresquare]

Nvm! Het is gelukt! Bedankt Warme Bakker! ;>

Cheers!

 

[Warme bakkertje]

Zie bijlage

 

[caresquare]

Zie bijlage

Wow, dat met het button'tje maakt het nog duizend maal gemakkelijker! :thumb:

Bedankt bakker!

 

[caresquare]

Zie bijlage

Zou ik nog een andere vraag mogen stellen? ;s hoe kan ik de code van de button aanpassen? Moest ik nu meer producten hebben ofzo?

Nog eens bedankt voor alles! ^^^^

 

[Warme bakkertje]

Bijlage aangepast

 

[caresquare]

Bijlage aangepast

Nog eens bedankt voor alles Bakkertje

 

[caresquare]

Bijlage aangepast

En als ik de Opmaak van de cellen ook wil mee kopieren? Sorry voor alle vragen!

 

[huijb]

Ja dit is mijn laatste jaar, en wil niet gebuist zijn voor een probleem die hier misschien kan opgelost worden

Victor

Dat is allemaal prachtig maar houd er rekening mee dat je hier van doen heb met vrijwilligers.

 

[caresquare]

Dat is allemaal prachtig maar houd er rekening mee dat je hier van doen heb met vrijwilligers.

Wat warme bakkertje al zei

>> Om je ongeduld wat te bekoelen, de helpers hier doen dit vrijwillig en in hun vrije tijd, dus zitten niet echt te wachten totdat iemand een vraag post en zij onmiddelijk een antwoord kunnen bieden.

 

[huijb]

Eén verschil, ik ben de mod en warm bakkertje niet. Ik geef je de waarschuwing uit hoofde van Helpmij.

 

[Warme bakkertje]

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Sheets("Offerte").Range("A2:B" & Sheets("Offerte").Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    For Each cl In Sheets("Producten").Range("C2:C" & Sheets("Producten").Cells(Rows.Count, 1).End(xlUp).Row)
        If cl = 1 Then
            cl.Offset(, -2).Resize(, 2).Copy
            With [offerte!A65536].End(xlUp).Offset(1).Resize(, 2)
                .PasteSpecial xlPasteValues
                 .PasteSpecial xlPasteFormats
            End With
        End If
    Next
    With Application
        .ScreenUpdating = True
        .CutCopyMode = False
    End With
End Sub

 

[caresquare]

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Sheets("Offerte").Range("A2:B" & Sheets("Offerte").Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    For Each cl In Sheets("Producten").Range("C2:C" & Sheets("Producten").Cells(Rows.Count, 1).End(xlUp).Row)
        If cl = 1 Then
            cl.Offset(, -2).Resize(, 2).Copy
            With [offerte!A65536].End(xlUp).Offset(1).Resize(, 2)
                .PasteSpecial xlPasteValues
                 .PasteSpecial xlPasteFormats
            End With
        End If
    Next
    With Application
        .ScreenUpdating = True
        .CutCopyMode = False
    End With
End Sub

Bedankt! Thoh

Heb net mijn opdracht ingedient, en hij vond geen fouten! Bedankt rudi