If Abfrage funktioniert nicht
22.01.2004 13:51:47
marc
mit meiner If- Abfrage habe ich bis dato keine Probleme.
Ab heute ist in dem Code etwas nicht in Ordnung. Warum ?
Info: In Sheets("Aus.Gr).Range("G2")steht Formel =Heute().
marc :o) ...
Sub DayStep2_()
Dim wb As Workbook
Set wb = ActiveWorkbook
Application.ScreenUpdating = False
Worksheets("Aus.Gr").Activate
Sheets("Werte").Range("G2") = Sheets("Aus.Gr").Range("G2").Value
If [H5] = "mo" Then
Worksheets("Werte").Activate
Range("G2").Copy
Workbooks.Open ("C:\Gera\T_B\Ber.xls")
Worksheets("Mo01").Activate
Range("G2").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
Worksheets("Ges_F").Activate
Range("D4").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
End If
If [H5] = "di" Then
Worksheets("Werte").Activate
Range("G2").Copy
Workbooks.Open ("C:\Gera\T_B\Ber.xls")
Worksheets("Di01").Activate
Range("G2").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
Worksheets("Ges_F").Activate
Range("D4").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
End If
If [H5] = "mi" Then
Worksheets("Werte").Activate
Range("G2").Copy
Workbooks.Open ("C:\Gera\T_B\Ber.xls")
Worksheets("Mi01").Activate
Range("G2").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
Worksheets("Ges_F").Activate
Range("D4").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
End If
If [H5] = "do" Then
Worksheets("Werte").Activate
Range("G2").Copy
Workbooks.Open ("C:\Gera\T_B\Ber.xls")
Worksheets("Do01").Activate
Range("G2").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
Worksheets("Ges_F").Activate
Range("D4").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
End If
If [H6] = "fr" Then
Range("H2").Activate
Sheets("Werte").Range("H2") = Sheets("Aus.Gr").Range("H2").Value
Worksheets("Werte").Activate
Range("H2").Copy
Workbooks.Open ("C:\Gera\T_B\Ber.xls")
Worksheets("Fr01").Activate
Range("G2").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
Worksheets("Ges_F").Activate
Range("D4").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
End If
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
Sheets(2).Activate
End Sub