kann mir wieder Hilfe von Euch bekommen?
Bei deisem Tabellencode habe ich irgenwo einen Fehler. Ich habe nur den ersten Monat Oktober mit eingefügt. Jetzt funktioniert es nicht mehr. Auch als Datei verfügbar. https://www.herber.de/bbs/user/65150.xls
Danke und Gruß Torsten
Private Sub Worksheet_Activate()
Dim E As Integer
Dim F As Integer
Dim I As Integer
Rem If Day(Now) = Date Then
E = 101
F = 25
For I = 2 To 8
.Cells(101, I).Value = Sheets("Ergebnisse").Cells(F, 13).Value
F = F + 1
Rem test1
Next I
E = 105
F = 15
For I = 3 To 8
.Cells(105, I).Value = Sheets("Ergebnisse").Cells(F, 13).Value
F = F + 1
Next I
Rem test2
E = 103
F = 46
For I = 2 To 8
.Cells(103, I).Value = Sheets("Ergebnisse").Cells(F, 13).Value
F = F + 1
Next I
Rem Mai_Juni
If DateSerial(2010, 6, 20) >= Date Then
E = 53
F = 25
For I = 2 To 8
.Cells(53, I).Value = Sheets("Ergebnisse").Cells(F, 10).Value
F = F + 1
Rem test1
Next I
E = 57
F = 15
For I = 3 To 8
.Cells(57, I).Value = Sheets("Ergebnisse").Cells(F, 10).Value
F = F + 1
Next I
Rem test2
E = 55
F = 46
For I = 2 To 8
.Cells(55, I).Value = Sheets("Ergebnisse").Cells(F, 10).Value
F = F + 1
Next I
Rem Juni_Juli
If DateSerial(2010, 7, 20) >= Date Then
E = 65
F = 25
For I = 2 To 8
.Cells(65, I).Value = Sheets("Ergebnisse").Cells(F, 11).Value
F = F + 1
Rem test1
Next I
E = 69
F = 15
For I = 3 To 8
.Cells(69, I).Value = Sheets("Ergebnisse").Cells(F, 11).Value
F = F + 1
Next I
Rem test2
E = 67
F = 46
For I = 2 To 8
.Cells(67, I).Value = Sheets("Ergebnisse").Cells(F, 11).Value
F = F + 1
Next I
Rem Juli_August
If DateSerial(2010, 8, 20) >= Date Then
E = 77
F = 25
For I = 2 To 8
.Cells(77, I).Value = Sheets("Ergebnisse").Cells(F, 12).Value
F = F + 1
Rem test1
Next I
E = 81
F = 15
For I = 3 To 8
.Cells(81, I).Value = Sheets("Ergebnisse").Cells(F, 12).Value
F = F + 1
Next I
Rem test2
E = 79
F = 46
For I = 2 To 8
.Cells(79, I).Value = Sheets("Ergebnisse").Cells(F, 12).Value
F = F + 1
Next I
Rem August_Sep
If DateSerial(2010, 9, 18) >= Date Then
E = 89
F = 25
For I = 2 To 8
.Cells(89, I).Value = Sheets("Ergebnisse").Cells(F, 13).Value
F = F + 1
Rem test1
Next I
E = 93
F = 15
For I = 3 To 8
.Cells(93, I).Value = Sheets("Ergebnisse").Cells(F, 13).Value
F = F + 1
Next I
Rem test2
E = 91
F = 46
For I = 2 To 8
.Cells(91, I).Value = Sheets("Ergebnisse").Cells(F, 13).Value
F = F + 1
Next I
End If
End
With
End Sub