Cellen copieren van ene naar andere werkblad

Status
Niet open voor verdere reacties.

Marthy Mc Fly

Gebruiker
Lid geworden
14 okt 2010
Berichten
117
Ik heb een werkblad (Opvolgblad Productie) dat dagelijks na elke shift ingevuld wordt en afgeprint om in te leveren.
Daarna wordt dit formulier gewist zodat de volgende shift zijn presaties kan invullen.
In wil nu dat er d.m.v. een knop die gegevens worden gecopieert naar een ander werkblad.
Voor elke maand staat er een werkblad. Dit is dus al één voorwaarde. Op werblad A staat de datum vermeld.
De gegevens moeten ook terecht komen bij de juiste shift en dag in elk maandwerkblad.
Wat moet gecopieert worden?
In werkblad (Opvolgblad Productie) moeten cellen A9 tot A18 gecopieert naar de juiste shift onder kolom Base Assy
samen met cellen C9 tot C18 die in de kolom van de aantalen moet staan.
Ik heb in het voorbeeld bestand wel een paar maanden moeten weglaten omdat bestand anders te groot was om te uploaden.

Bekijk bijlage Productieboek Tube Forming B-Lijn 2013.xls
 
In de bijlage heb ik gevraagde kopieer-acties onder de knop gezet.
De code is met enige uitleg te vinden op module 2

De validatie van de diensten heb ik aangepast naar een benoemde lijst.
Een weekenddienst wordt altijd op de juiste plek gezet, maar verder is er nog wel uitbreiding mogelijk/noodzakelijk om fouten te voorkomen.
Zie dit dus als een opzet.
Mvg Leo
Bekijk bijlage Kopie van Productieboek Tube Forming B-Lijn 2013.xls
 
Hallo Leo,

Alvast bedankt voor de reactie. Ik heb verschillende zaken uitgeprobeerd en
de code blijkt toch te werken. Begrijp dus niet echt goed wat u wil zeggen met
"uitbreiding mogelijk/noodzakelijk om fouten te voorkomen."
Waar zouden volgens u zich dan fouten kunnen voor doen. Ik vraag dit omdat
VBA niet echt mijn ding is.

Greetz

Geert
 
Hallo Leo,

Heel erg bedankt voor deze extra toevoeging.
Voor de datum staat er op werkblad A normaal een excel code.
Deze moet men dus niet zelf invullen, dit wordt automatisch gedaan.
De verschillende maandwerkbladen maak ik zelf aan, maar moest ze in het voorbeeld
weggelaten omdat bestand anders te groot was om te posten hier.
Alleen wat betreft die shift moet ik nog naar een betere oplossing zoeken.
Maar toch bedankt voor de extra veiligheden. Je weet maar nooit natuurlijk.


Greetz


Geert
 
Ik kan hier zeker iets mee. Ik tracht het zelfs nog uit te breiden.
Je kan met VBA nl. zeer veel bereiken. Alleen spijtig dat ik er veel te
weinig kaas van gegeten heb.
Zo zou ik nog één klein zaakje willen vragen. Als ik een error erbij wil, kan dit dan gewoon
bijgevoegd worden bij de andere. Het is nl. zo dat met in werkblad A Van cellen A9 tot A18,
een productie nr moeten invoeren. Dit nr bevat steeds 8 cijfers (soms zitten er ook letters tss).
Het is nu zo dat sommigen wat lui zijn en alleen de laatste vier cijfers ingeven.
Ik zou dus willen dat hij dat een foutmelding geeft. Dit is volgens mij een heel eenvoudige code.
Maar als je zoals ik al eerder zei er geen kaas van gegeten hebt, dan is dit niet zo evident.

Greetz

Geert
 
Het kan inderdaad in via de foutafhandeling
Dat zou dan controle achteraf zijn en dus te eigenlijk laat
Daarom zou het meer voor de hand liggem om dit in het Worksheet_change event te doen.

Maar het kan ook met validatie op de betreffende cellen en dat is net zo makkelijk.
Kies tekstlengte "gelijk aan" 8 en foutmelding "stopppen, met een bericht naar keuze.

Mvg Leo
 
Ik had ook al gedacht aan dat laatste met validatie.
Dat lijkt me het eenvoudigste.
Toch nog een vielen dank voor de hulp.

Groeten

Geert
 
Uitbreiding op huidige situatie

Ruim een jaar lang hebben we gebruik kunnen maken van dit bestand. Alleen de afgelopen 2 maanden waren er problemen.
Namelijk de weekend shift werd opgesplitst in twee. Het normale weekend werd een dubbele weekend shift.
Hierdoor konden zij hun gegevens niet meer wegschrijven omdat er maar één kolom voorzien was voor weekend dienst
in de tabbladen die de maanden voorstelden. Met zicht op het nieuwe jaar zoek ik naar een oplossing voor dit probleem.
Ik moet dus het weekend gaan voorzien van twee kolommen. Met name de dag en nacht shift. Alleen zit ik vast met
de vba code die schuil gaat achter de knop transfer op het hoofdblad genaamd Opvolgblad productie.
Vba is voor mij als chinees. Vandaar een oproep naar de experts of de bouwer van deze code.

Hier onder vindt je een voorbeeld van het bestand.
 

Bijlagen

Laatst bewerkt:
Het gaat dus om deze code
Code:
Sub Transfer()

Dim iRij As Integer
Dim iKolom As Integer
Dim dDatum As Date
Dim sShift As String
Dim sh As Worksheet
   On Error GoTo Transfer_Error

Application.ScreenUpdating = False
dDatum = Cells(4, 2)
sShift = Cells(4, 5)
'controleer of er een datum en een dienst is ingevuld.
    If sShift = "" Or dDatum = 0 Then
        MsgBox "Vul datum en/of dienst in"
            Exit Sub
    End If
Set sh = Worksheets(UCase(Strings.Format(dDatum, "mmm")))
'controleer weekdag.
    If Weekday(dDatum, 2) > 5 Then
    'weekenddag? maak er dan een weekenddienst van
            iKolom = WorksheetFunction.Match(Cells(4, 5), Range("dienst"), 0) * 5
            
        Else
    'weekdag stel dan de kolom in op de juiste dienst.
            iKolom = WorksheetFunction.Match(Cells(4, 5), Range("dienst"), 0) * 3
    End If
'zoek de datum op en stel de rij in
iRij = WorksheetFunction.Match(Cells(4, 2), sh.Range("A5:A436"), 0) + 4
'kopieer de waardes naar de juiste plaats
    Range("A9:A20").Copy
        sh.Cells(iRij, iKolom).PasteSpecial xlValues
    Range("C9:C20").Copy
        sh.Cells(iRij, iKolom + 1).PasteSpecial xlValues
'selecteer de datum cel(en haal de kopieer kringels weg)
 With Application
    If .CutCopyMode Then .CutCopyMode = False
 End With
    Cells(4, 2).Select
    Call MsgBox("Gegevens zijn overgeschreven")

     
   On Error GoTo 0
   Exit Sub
'foutafhandeling
Transfer_Error:
'als het blad niet bestaat
If Err.Number = 9 Then
        Call MsgBox("Voor de betreffende maand is geen werkblad aanwezig" _
                & vbCrLf & "Voeg dit toe en voer de routine opnieuw uit." _
                , vbCritical, "Werkblad ontbreekt")
'datum niet aanwezig
    ElseIf Err.Number = 1004 Then
        Call MsgBox("De ingevoerde datum is niet gevonden." _
                    & vbCrLf & "Controleer of deze bestaat en voer de routine opnieuw uit." _
                    , vbCritical, "Onjuiste datum")
    Else
'alle andere fouten
        Call MsgBox("Er is een onbekende fout opgetreden." _
                & vbCrLf & vbCrLf & "Foutnummer: " & Err.Number _
                & vbCrLf & "Beschrijving: " & Err.Description _
                , vbCritical, "onbekende fout")
End If
    
    
End Sub

Waarin het volgens mij vooral ligt aan het volgende gedeelte
Code:
'controleer weekdag.
    If Weekday(dDatum, 2) > 5 Then
    'weekenddag? maak er dan een weekenddienst van
            iKolom = WorksheetFunction.Match(Cells(4, 5), Range("dienst"), 0) * 5
            
        Else
    'weekdag stel dan de kolom in op de juiste dienst.
            iKolom = WorksheetFunction.Match(Cells(4, 5), Range("dienst"), 0) * 3
    End If

Wat wil in deze code eigenlijk de *5 en de *3 zeggen
 
Hallo Geert,
Ik heb het volgende aangepast.
voor de weekenden, twee diensten toegevoegd n.l weekend dag en weekend nacht.
Daarbij heb ik de foutcontrole uitgebreid, zodat alleen deze diensten in het weekend gebruikt kunnen worden en niet door de weeks en andersom.

De *5 was al weg uit de code en de * 3 rekent de het indexnummer van de dienstenlijst om in een kolom nummer.
ik hoop dat dit is wat je bedoelde
Zie bijlage
Bekijk bijlage Productieboek 2014.xls
Mvg Leo
 
Hallo Leo,

Dit is inderdaad wat ik zoek. Ik heb er een tijdje zelf mijn hoofd op gebroken, maar tevergeefs.
Het programmeren met vba blijft een brug te ver voor mij. Dit betekend meteen ook dat ik
met het opsplitsen van het weekend, het datum probleem heb kunnen verhelpen. Deze wordt
via formule nu automatisch toegevoegd. In het verleden vergat men deze de dag nadien wel
eens te veranderen, waardoor eerder verplaatste gegevens werden overschreven.
Als men natuurlijk er in slaagt mijn formule te elimineren dan blijf dit een probleem.
Daarom dacht ik aan een error als men gegevens gaat overschrijven. Met de keuze als men
dit wil doen of niet.
Een ander probleem wat nog rest is het beveiligen van de maandtabbladen.
Ik deed dit met de volgende code:
Code:
Sub test()
  For Each it In Array("JAN", "FEB", "MAA", "APR", "MEI", "JUN", "JUL", "AUG", "SEP", "OKT", "NOV", "DEC")
    if sheets(it).protectionmode then sheets(it).Unprotect "PW"
  Next

_ _ _ _ _   code


  For Each it In Array("JAN", "FEB", "MAA", "APR", "MEI", "JUN", "JUL", "AUG", "SEP", "OKT", "NOV", "DEC")
    Sheets(it).Protect "PW", UserInterfaceOnly:=True
  Next
End Sub

Deze code werkte perfect, totdat je om een of andere reden de pc opnieuw moest opstarten. Dan was de
beveiliging op de tabbladen weg. Ik twijfel of dit te maken heeft met instellingen van makro op pc zelf.
Verder moet ik je alweer bedanken voor de grote hulp en mag ik je het beste wensen voor het nieuwe jaar.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan