Invullen rooster met vba

[rg027]

Beste excelkenners,

Ik zou graag met de hulp van een vba code een jaarrooster invullen aan de hand van gegevens die worden ingevuld op blad 1. In de bijlage heb ik een invulblad (blad1) en al 1 blad voor 3 maanden (van jan tot maart, zou komen er nog 3 werkbladn bij voor de overige maanden). Zoals in het voorbeeld zou voor reeks1 op 3/1/2007 de code 1 moeten ingevuld worden in de rooster. Met formules werken mag niet daar de cellen kunnen overschreven worden. Ook ingevulde cellen mogen niet overschreven worden.

Wie oh wie kan me helpen met deze code?

Alvast hartelijke dank

 

[rg027]

Het lukt me niet om een rar bijlage te plaatsen

 

[rg027]

ziehier het bestand.

 

[rg027]

Echt niemand die kan helpen?

 

[Wigi]

Vooruit dan, hier is wat code.

Option Explicit

Sub zetcodesweg()
    Dim c As Range, rng As Range
    For Each c In Range("C3", Range("C" & Rows.Count).End(xlUp))
        With Sheets("Jan-Feb-Mrt")
            Select Case Month(c.Offset(, -1))
                Case 1
                    Set rng = .Range("B2:AF10")
                Case 2
                    Set rng = .Range("B13:AC21")
                Case 3
                    Set rng = .Range("B24:AF32")
            End Select
        End With
        rng.Cells(Val(Replace(c.Offset(, -2), "Reeks", "")), Day(c.Offset(, -1))) = c
    Next c
End Sub

Ik besef dat het wel wat efficiënter kan en zo, maar het werkt wel.

Wigi

 

[rg027]

Wigi,

Bedankt voor je medewerking. De code doet het goed, maar........... ze overschrijft wel de gegevens en dat is niet de bedoeling. Als er in een bepaalde cel toevalig gegevens zijn ingevoegd mogenn deze niet overshreven worden.

 

[Wigi]

Zo dan.

Option Explicit

Sub zetcodesweg()
    Dim c As Range, rng As Range
    For Each c In Range("C3", Range("C" & Rows.Count).End(xlUp))
        With Sheets("Jan-Feb-Mrt")
            Select Case Month(c.Offset(, -1))
                Case 1
                    Set rng = .Range("B2:AF10")
                Case 2
                    Set rng = .Range("B13:AC21")
                Case 3
                    Set rng = .Range("B24:AF32")
            End Select
        End With
        If rng.Cells(Val(Replace(c.Offset(, -2), "Reeks", "")), Day(c.Offset(, -1))) = "" Then rng.Cells(Val(Replace(c.Offset(, -2), "Reeks", "")), Day(c.Offset(, -1))) = c
    Next c
End Sub

Wigi

 

[rg027]

Wigi,

Dat is het. Hartelijke dank.