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

Ingevulde cellen kopieren

Status
Niet open voor verdere reacties.
Bart Smith,

Je kan deze natuurlijk van te voren invullen, dan heb je daar geenlast meer van.
 
@ Hoornvan

Kan ik inderdaad doen maar dan kan ik het detailblad toch niet voor een heel jaar gebruiken? Dit is nl de bedoeling van het detailblad; zo kan ik zie wie wat en hoeveel uit het magazijn nam.
 
De aangepaste code van Roncancio, heeft mij al een heel eind op weg geholpen maar heb nog 2 probleemjes;:o
1. Ik heb het bereik uitgebreid naar B4 : D11 om ook de artikels meet op het detailblad te zien. wanneer ik nu de macrocopy uitvoer, word dit zelfde bereik gekopieerd.
Is het niet mogelijk een stukje code toe te voegen zodanig dat enkel die rijen gekopieerd worden waar iets ingevuld staat in C4 : D11.

BV als iemand een jas maat 50 en 58 neemt enkel deze 2 rijen gekopieerd worden?

2. Op het detailblad worden de gegevens telkens overschreven, hoe plak ik die op een nieuwe rij?

In onderstaande macro wordt gecontroleerd of er iets is ingevuld in de B-kolom van blauwe jas. Indien dat het geval is worden de ingevulde regels in detail ingevuld.
Je moet maar even kijken of dit is wat je voor ogen heeft. Het is zonder voorbeeld wat lastig te bepalen hoe je het precies wilt hebben.
Ik vroeg mij af of we de code niet nog flexibeler moeten maken. Ik neem bijvoorbeeld aan dat er in het assortiment ook rode, groene jassen zijn. Een macro voor elke jas is niet handig.

Code:
' De macro is opgemaakt op 20/10/2008 door Een ander.
Sub MacroLeegBlad()
Dim rBereik As Range
    Application.ScreenUpdating = False
    For Each rBereik In Sheets("Blauwe jas").Range("D4:D11")
        rBereik.Value = rBereik.Value - rBereik.Offset(0, -2).Value
    Next
    Sheets("Blauwe jas").Range("C4:C11").ClearContents
    Application.ScreenUpdating = True
End Sub

Code:
Sub MacroCopy()
Dim rBereik As Range
Dim lRij As Long
    lRij = Worksheets("Detail").Range("C65536").End(xlUp).Row + 1
    Application.ScreenUpdating = False
    For Each rBereik In Worksheets("Blauwe jas").Range("B4:B11")
        If rBereik.Value <> "" Then
            Worksheets("Blauwe jas").Range("B" & rBereik.Row & " :D" & rBereik.Row).Copy
            Worksheets("detail").Range("B" & lRij & " :D" & lRij).PasteSpecial Paste:=xlPasteValues
            lRij = lRij + 1
        End If
    Next
    Sheets("Detail").Columns("A:A").EntireColumn.AutoFit
    Sheets("Detail").Columns("A:A").ColumnWidth = 21.57
    Application.CutCopyMode = False
    MacroLeegBlad
    Application.ScreenUpdating = True
    
End Sub

Met vriendelijke groet,


Roncancio
 
Roncancio,

De macro geeft de volgende fout: Fout 13, typen komen niet met elkar overeen
Code:
Sub MacroLeegBlad()
Dim rBereik As Range
    Application.ScreenUpdating = False
    For Each rBereik In Sheets("Blauwe jas").Range("D4:D11")
        [COLOR="Red"]rBereik.Value = rBereik.Value - rBereik.Offset(0, -2).Value[/COLOR]
    Next
    Sheets("Blauwe jas").Range("C4:C11").ClearContents
    Application.ScreenUpdating = True
End Sub
 
Roncancio,

Ik heb het al gevonden,
Code:
Sub MacroLeegBlad()
Dim rBereik As Range
    Application.ScreenUpdating = False
    For Each rBereik In Sheets("Blauwe jas").Range("[COLOR="Red"]F4:F11[/COLOR]")
        rBereik.Value = rBereik.Value - rBereik.Offset(0, -2).Value
    Next
    Sheets("Blauwe jas").Range("[COLOR="Red"]C4:D11[/COLOR]").ClearContents
    Application.ScreenUpdating = True
End Sub
En daar heb ik van de 1 een 2 gemaakt, nu komt er een lege regel tussen.
Code:
lRij = Worksheets("Detail").Range("C65536").End(xlUp).Row + [COLOR="red"]2[/COLOR]
 
Laatst bewerkt:
@ Hoornvan & Roncancio

Dag experts,

Ik heb inderdaad ook gezien dat er een fout was in de code maar had dit zelf niet kunnen oplossen.:o

Maar nu; om op de vraag van Roncancio te voldoen, in bijlage een verder uitgewerkte inventaris.

Wanneer iemand op een van de tabbladen een artikel uit het magazijn wil, moet hij zijn 4letterafkorting in kolom C invullen en het genomen aantal in kolom D.
Wanneer de knop actualiseren ingedrukt wordt (om de macro's te starten), wordt de kolom F aangepast.
Nu zou ik willen, dat wanneer iemand bv 3 blauwe jassen mt 54 neemt, en hij de knop heeft ingedrukt, enkel de cellen B7,C7 en D7 op het detailblad worden gekopieerd in de eerstvolgende vrij rij op het detailblad.
Indien deze of een andere persoon een ander artikel neemt, moet dit onder de vorige rij komen te staan.
Aan de hand van het detailblad kan ik dan na elk jaar zien wie wat en hoeveel uit het magazijn nam.

Hopelijk ben ik duidelijk genoeg geweest in de beschrijving want zonder jullie kan ik dit zeker niet tot een goed einde brengen!
 

Bijlagen

Bart Smith,

Ik heb dit van de code gemaakt, stukje veranderd, nu copieerd hij de regels waar wat staat.
Als je het direct onder elkaar wil hebben moet je .Row + 2 veranderen in .Row + 1
Code:
Sub MacroCopy()
Dim rBereik As Range
Dim lRij As Long
    lRij = Worksheets("Detail").Range("C65536").End(xlUp).[COLOR="red"]Row + 2[/COLOR]
    Application.ScreenUpdating = False
    For Each rBereik In Worksheets("Blauwe jas").Range("[COLOR="Red"]D4:D11[/COLOR]")
        If rBereik.Value <> "" Then
            Worksheets("Blauwe jas").Range("B" & rBereik.Row & " :D" & rBereik.Row).Copy
            Worksheets("detail").Range("B" & lRij & " :D" & lRij).PasteSpecial Paste:=xlPasteValues
            lRij = lRij + 1
        End If
    Next
    Sheets("Detail").Columns("A:A").EntireColumn.AutoFit
    Sheets("Detail").Columns("A:A").ColumnWidth = 21.57
    Application.CutCopyMode = False
    MacroLeegBlad
    Application.ScreenUpdating = True    
End Sub
Ik denk dat je het zelf wel kunt aanpassen voor de andere TabBladen
 
Ik denk dat je het zelf wel kunt aanpassen voor de andere TabBladen

Ik neem aan dat als de macro gestart wordt, dat het geldt voor het actieve werkblad en om de gegevens in detail te zetten.
Dus zou je ipv
Code:
worksheets("blauwe jas")
gebruik kunnen maken van
Code:
ActiveSheet

Ik heb de macro niet getest (geen tijd) maar ik ga er vanuit dat het in orde is.

Met vriendelijke groet,


Roncancio
 
Roncancio,

Ik neem aan dat als de macro gestart wordt, dat het geldt voor het actieve werkblad en om de gegevens in detail te zetten.
Dus zou je ipv
Code:
worksheets("blauwe jas")
gebruik kunnen maken van
Code:
ActiveSheet
Ik heb de macro niet getest (geen tijd) maar ik ga er vanuit dat het in orde is.


Het werkt zo als je voorstelde.
Ik was iets te snel met het antwoord, moet nog even zoeken waarom het nietecht lukt.
 
Laatst bewerkt:
Roncancio,

Ik had deze ook veranderd, daar zat het in, mijn fout.
Code:
Worksheets("detail")
Het werkt nu dus wel.
 
Ik had deze ook veranderd, daar zat het in, mijn fout.
Code:
Worksheets("detail")
Het werkt nu dus wel.

Iets te ijverig ?:p :thumb:
Volgens mij staat er nu dus 2 keer ActiveSheet.

Code:
Sub MacroCopy()
Dim rBereik As Range
Dim lRij As Long
    lRij = Worksheets("Detail").Range("C65536").End(xlUp).Row + 2
    Application.ScreenUpdating = False
    For Each rBereik In [B][COLOR="Blue"]ActiveSheet[/COLOR][/B].Range("D4:D11")
        If rBereik.Value <> "" Then
            [B][COLOR="blue"]ActiveSheet[/COLOR][/B].Range("B" & rBereik.Row & " :D" & rBereik.Row).Copy
            Worksheets("detail").Range("B" & lRij & " :D" & lRij).PasteSpecial Paste:=xlPasteValues
            lRij = lRij + 1
        End If
    Next
    Sheets("Detail").Columns("A:A").EntireColumn.AutoFit
    Sheets("Detail").Columns("A:A").ColumnWidth = 21.57
    Application.CutCopyMode = False
    MacroLeegBlad
    Application.ScreenUpdating = True    
End Sub
Voor de rest heb ik niets aan je vorige code veranderd.

Met vriendelijke groet,


Roncancio
 
Bart Smith,

Hier is het bestand, op het blad details heb ik er nog wat bij gemaakt.
Hij telt het aantal dat is uitgegeven.
Kijk maar of je het wat vind.

suc6
 

Bijlagen

@ Hoornvan

Dag Wim,

Ik kan jammer genoeg het bestandje niet openen maar de code die ik gekopieerd heb van jullie werkt prima !

Dank U;

Ik had wel graag nog geweten wat je veranderd hebt op de detailpagina.

Groeten en hartelijk bedankt Hoornvan & Roncancio!!
 
Bart Smith,

Ik kan het eventueel ook per e-mail sturen, als je dat wilt.
Moet je alleen je adres (e-mail) geven.
 
Bart Smith,

Graag gedaan.
We moeten natuurlijk niet vergeten dat Roncancio een erg belangrijk deel (de Macro) heeft gemaakt.
Hij schut ze volgens mij zo uit de mouw, zonder hem was het mischien niet gelukt.
 
Bart Smith,

Graag gedaan.
We moeten natuurlijk niet vergeten dat Roncancio een erg belangrijk deel (de Macro) heeft gemaakt.
Hij schut ze volgens mij zo uit de mouw, zonder hem was het mischien niet gelukt.

Dank u:o:o
Er zijn er wel meer die dit kunnen.
U doet ook geen gering werk door de macro's aan te passen en zonodig te corrigeren.:thumb:

Met vriendelijke groet,


Roncancio
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan