Automatisch lege cel selecteren en vullen met waarde op ander tabblad

[sjoerdvdploeg]

Ik stuit weer op een probleempje met VBA.

Ik wil graag dat als ik een naam (e.a. gegevens) invul op het tabblad 'Namen' dat deze (zodra er op een knop wordt gedrukt) wordt ingevuld in het eerst volgende lege cel in het tabblad 'Invoer en data'.

Nu is dat nog niet zo'n groot probleem. Maar ik wil ook dat deze naam 365 keer eronder verschijnt met de juiste datum erachter.

Op dit moment gebruiken we een ander bestandje om dit in te voeren maar gezien ik de gemaakt uren wil koppelen aan een andere werkmap moet ik het op een andere manier porberen te fixen.

Het lukt me wel om de eerste lege cel te selecteren met
Range("A1").Select
Selection.End(xlDown).Offset(1, 0).Select

En om de juiste gegevens voor 1 persoon te laten verschijnen op het tabblad 'Invoer en data' is ook geen probleem... maar deze 2 combineren. Ik kom er niet uit, ik heb er op dit moment al veel gefrustreerde uren (lees dagen) aan besteed maar ik kom er niet uit. Mijn kennis van VBA is voor alsnog te beperkt hiervoor. Alvast bedankt voor de hulp.

De code die er nu instaat kan genegeerd worden.

Bekijk bijlage Urenregistratie.xls

 

[HSV]

De rij van je activecell wordt 365x weggeschreven.
Maar welke datum moet verschijnen in de kolom ernaast.

Sub tst()
With Sheets("Namen")
  If Intersect(ActiveCell, Columns(1)) Is Nothing Then
    GoTo einde
 Else
   Sheets("Invoer en data").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(365, 6).Value = _
       ActiveCell.Resize(, 6).Value
      End If
    End With
  Exit Sub
einde:  MsgBox "De actieve cel bevindt zich niet in kolom A "
End Sub

 

[sjoerdvdploeg]

De rij van je activecell wordt 365x weggeschreven.
Maar welke datum moet verschijnen in de kolom ernaast.

Sub tst()
With Sheets("Namen")
  If Intersect(ActiveCell, Columns(1)) Is Nothing Then
    GoTo einde
 Else
   Sheets("Invoer en data").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(365, 6).Value = _
       ActiveCell.Resize(, 6).Value
      End If
    End With
  Exit Sub
einde:  MsgBox "De actieve cel bevindt zich niet in kolom A "
End Sub

Dag HSV,

Bedankt voor je reactie en de oplossing! De data van 1 januari 2011 t/m 31 december 2011 moet er achter verschijnen. Als dit ook nog lukt dan heb je mij echt enorm geholpen!

PS: Nu al fan van dit forum.

 

[HSV]

Bij deze Sjoerd.

Sub tst()
Dim datumrange
 Set datumrange = Worksheets("Invoer en data").Cells(Rows.Count, 7).End(xlUp).Offset(1).Resize(365)
With Sheets("Namen")
  If Intersect(ActiveCell, Columns(1)) Is Nothing Then GoTo einde
With Sheets("Invoer en data")
  .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(365, 6).Value = ActiveCell.Resize(, 6).Value
  .Cells(Rows.Count, 7).End(xlUp).Offset(1).Formula = "1-1-2011"
  datumrange.DataSeries Type:=xlChronological, Date:=xlDay
      End With
    End With
  Exit Sub
einde:  MsgBox "De actieve cel bevindt zich niet in kolom A    "
End Sub

 

[Warme bakkertje]

Zet er het formaat, de uitlijning en de formule voor het weeknr nog bij en het zaakje is compleet

Sub tst()
Dim datumrange
Set datumrange = Worksheets("Invoer en data").Cells(Rows.Count, 7).End(xlUp).Offset(1).Resize(365)
With Sheets("Namen")
    If Intersect(ActiveCell, Columns(1)) Is Nothing Then MsgBox "De actieve cel bevindt zich niet in kolom A    ": Exit Sub
        With Sheets("Invoer en data")
            .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(365, 6).Value = ActiveCell.Resize(, 6).Value
            .Cells(Rows.Count, 7).End(xlUp).Offset(1).Formula = "1-1-2011"
            With datumrange
                .DataSeries , xlChronological, xlDay
                .NumberFormat = "ddd dd mmmm"
                .HorizontalAlignment = xlLeft
                .Offset(, 1).Formula = "=Isoweek(RC[-1])"
            End With
        End With
End With
End Sub

Function IsoWeek(d1)
  IsoWeek = Format(d1, "ww", 2) - IIf(Format("04-01-" & Year(d1), "ww", 2) = 2, 1, 0)
  If IsoWeek = 0 Then IsoWeek = 53
End Function

 

[sjoerdvdploeg]

2011 begint goed! Werkt perfect.

Warme bakkertje en HSV, hartelijk dank!