Ich brauche einfach Hilfe
07.04.2005 21:21:04
marc
vielleicht ist einer von den unsichtbaren VBA Profis bereit mir
weiter zu helfen.
Ich habe ein VBA-Programm geschrieben und wieder etwas veraendert bzw.
hier und da etwas angepasst.
Die Idee ist eigentlich sichtbar.In dem aktuellen Stadium kann ich mit dem
Code kein Befehl starten.Kann mir jemand weiterhelfen bzw. den Code verbessern?
-
marc .
Sub ErrorOn()
Dim wb As Workbook
Set wb = ActiveWorkbook
Worksheets("Aus.Gr").Activate
If [G5] = "10" Then
Sheets("Werte").Range("B7:J16") = Sheets("Aus.Gr").Range("B9:J18").Value
Sheets("Werte").Range("G2") = Sheets("Aus.Gr").Range("G2").Value
Sheets("Werte").Range("J19") = Sheets("Aus.Gr").Range("J3").Value
Sheets("Werte").Range("J20") = Sheets("Aus.Gr").Range("J5").Value
End If
If [H5] = "mo" Then
Worksheets("Werte").Activate
Range("C7:J16, J3, J5").Copy
Workbooks.Open ("C:\Lauf\Bericht\Tag.xls")
Worksheets("Mo01").Activate
Range("C7:J16, J19, J20").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
End If
If [H5] = "di" Then
Worksheets("Werte").Activate
Range("C7:J16, J3, J5").Copy
Workbooks.Open ("C:\Lauf\Bericht\Tag.xls")
Worksheets("Di01").Activate
Range("C7:J16, J19, J20").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
End If
If [H5] = "mi" Then
Worksheets("Werte").Activate
Range("C7:J16, J3, J5").Copy
Workbooks.Open ("C:\Lauf\Bericht\Tag.xls")
Worksheets("Mi01").Activate
Range("C7:J16, J19, J20").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
End If
If [H5] = "do" Then
Worksheets("Werte").Activate
Range("C7:J16, J3, J5").Copy
Workbooks.Open ("C:\Lauf\Bericht\Tag.xls")
Worksheets("Do01").Activate
Range("C7:J16, J19, J20").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
End If
If [H5] = "fr" Then
Worksheets("Werte").Activate
Range("C7:J16, J3, J5").Copy
Workbooks.Open ("C:\Lauf\Bericht\Tag.xls")
Worksheets("Fr01").Activate
Range("C7:J16, J19, J20").PasteSpecial Paste:=xlValue, Paste:=xlFormats
Range("J2").Activate
End If
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Sheets(2).Activate
End Sub