automatisch vullen datum, week, maand in een tabel

[jcb1958]

Beste,

Ik heb een tabel waaraan dagelijks waarden worden toegevoegd in kolom D met een Macro. In kolom A,B en C blijven de cellen leeg en moet deze nu handmatig vullen. Ik zou dat graag met een macro willen. Ik kom er zelf helaas niet helemaal uit.

zie voorbeeld bestand

Gr

JCB


Bekijk bijlage Map juiste.xlsx

 

[edmoor]

Probeer dit eens:
Bekijk bijlage Map1.xlsm

 

[jcb1958]

Probeer dit eens:
Bekijk bijlage 237367

Hoi Edmoor

dank voor je snelle reactie. ik kom er echter net achter dat ik het verkeerde bestand heb gepost. Ik heb het juiste bestand nu in de originele post gezet

 

[edmoor]

Maakt niet uit, je kan dezelfde macro achter Blad1 zetten.
Je moet dan alleen het datumformaat aanpassen.
Wil je dat ik dat voor je doe?

Edit:
Deze dan:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 4 Then
        Cells(Target.Row, 1) = Format(Date, "dd-mmm")
        Cells(Target.Row, 2) = Format(Date, "ww")
        Cells(Target.Row, 3) = Format(Date, "mm")
    End If
End Sub

Je hebt het trouwens over een macro maar die zit niet in dat blad.
Klopt dat?

 

[jcb1958]

Maakt niet uit, je kan dezelfde macro achter Blad1 zetten.
Je moet dan alleen het datumformaat aanpassen.
Wil je dat ik dat voor je doe?

Edit:
Deze dan:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 4 Then
        Cells(Target.Row, 1) = Format(Date, "dd-mmm")
        Cells(Target.Row, 2) = Format(Date, "ww")
        Cells(Target.Row, 3) = Format(Date, "mm")
    End If
End Sub

Je hebt het trouwens over een macro maar die zit niet in dat blad.
Klopt dat?

Hoi ED

Ik heb de code erin gezet thx

klopt idd dat er geen macro inzit; dit was maar een voorbeeldbestandje

wat niet goed gaat nog is dat als ik bij. 5 rijen toevoeg met de macro dan veranderd met jouw code alleen de 1e toegevoegde rij met de datum week en maand maar niet de andere 4 rijen

 

[edmoor]

Zet er dan bij iedere toevoeging eens de opdracht DoEvents onder.

 

[jcb1958]

Zet er dan bij iedere toevoeging eens de opdracht DoEvents onder.

heb het nu zo gezet , maar werkt niet

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 Then
Cells(Target.Row, 1) = Format(Date, "dd-mmm")
DoEvents
Cells(Target.Row, 2) = Format(Date, "ww")
DoEvents
Cells(Target.Row, 3) = Format(Date, "mm")
DoEvents
End If
End Sub

 

[edmoor]

Nee, niet daar. In je eigen macro die het toevoegen van de regels verzorgt.

 

[jcb1958]

Nee, niet daar. In je eigen macro die het toevoegen van de regels verzorgt.

Helaas lukt het nog niet

heb de map weer bijgevoegd ook met de eigen macro importeren


Bekijk bijlage Map1_test.xlsm

 

[edmoor]

Ok, dat komt dus omdat je een hele range ineens plaatst. Verwijder de routine achter het werkblad en gebruik deze als je Import routine:

Sub import()
    Windows("Portefeuille.xlsx").Activate
    Range("B4:b12").Select
    Selection.Copy
    Windows("Map1_test.xlsm").Activate
    With Sheets("Blad1")
        .Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
        For i = 1 To .UsedRange.Rows.Count
            If Cells(i, 1) = "" Then
                .Cells(i, 1) = Format(Date, "dd-mmm")
                .Cells(i, 2) = Format(Date, "ww")
                .Cells(i, 3) = Format(Date, "mm")
            End If
        Next i
    End With
End Sub

 

[jcb1958]

Ok, dat komt dus omdat je een hele range ineens plaatst. Verwijder de routine achter het werkblad en gebruik deze als je Import routine:

Sub import()
    Windows("Portefeuille.xlsx").Activate
    Range("B4:b12").Select
    Selection.Copy
    Windows("Map1_test.xlsm").Activate
    With Sheets("Blad1")
        .Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
        For i = 1 To .UsedRange.Rows.Count
            If Cells(i, 1) = "" Then
                .Cells(i, 1) = Format(Date, "dd-mmm")
                .Cells(i, 2) = Format(Date, "ww")
                .Cells(i, 3) = Format(Date, "mm")
            End If
        Next i
    End With
End Sub

Ed

super het werkt....thx so much

JCB

 

[jcb1958]

Ed

super het werkt....thx so much

JCB

Toch nog een probleempje:


.Cells(i, 1) = Format(Date, "dd-mmm")

werkt verder prima alleen:

In het doelbestand is het datumformaat 26-5-2015 en wordt weergegeven als 26-mei

met jouw code komt daar alleen 26-mei en kan deze niet aanpassen naar formaat van de andere datumcellen

Hierdoor klopt de datumvolgorde in de draaitabel niet meer.

 

[edmoor]

Ok, maak er dan eens dit van:

Sub import()
    Dim sRow As Long

    Windows("Portefeuille.xlsx").Activate
    Range("B4:B12").Select
    Selection.Copy
    Windows("Map1_test.xlsm").Activate
    With Sheets("Blad1")
        .Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
        For i = 1 To .UsedRange.Rows.Count
            If Cells(i, 1) = "" Then
                If sRow = 0 Then sRow = i - 1
                .Cells(i, 1).NumberFormat = "dd-mmm"
                .Cells(i, 1) = Date
            End If
        Next i
        .Range("B" & sRow & ":C" & .UsedRange.Rows.Count).FillDown
    End With
End Sub