Woran kann das liegen?
Danke
Alfred
ohne Code kann man kein Wort drüber verlieren ;-)
Wenn du über nen CommandButton startest, dann ggf.
die TakeFocusOnCLick Eigenschaft des Buttons auf false...
Bye
Nike
Private Sub CommandButton1_Click()
Dim wks As Worksheet 'Die Variable wks als Tabellenblatt festlegen
If ActiveCell.Column <> 2 Then 'Fehlermeldung, wenn kein Datum ausgewählt
MsgBox "Woher soll ich denn wissen, für welches Datum Sie den Tagesdienstplan sehen möchten, wenn Sie kein Datum ausgewählt haben ??? Bitte wählen Sie ein Datum aus, Sie ........!", vbQuestion, "CASINO SCHENEFELD - FEHLER !!"
Exit Sub
End If
Application.ScreenUpdating = False 'Bildschirmaktualisierung abschalten
Set wks = ActiveSheet 'Die Variable wks wird dem aktiven Tabellenblatt zugewiesen
Sheets("Tag").Select ' Blatt "Tag" auswählen
Range("A1:B50").Select ' a1 - b50 auswählen
Selection.ClearContents 'Inhalte löschen
wks.Range("D3:AM3").Copy '"Einteilung - D3 bis AM3" (Namen) kopieren
Sheets("Tag").Select 'Tabellenblatt "Tag" aufrufen
Range("A2").Select 'Zelle A2 markieren
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True 'Namen einfügen (von oben nach unten)
wks.Select 'Tabelle "Einteilung" aufrufen
wks.Range(Cells(Selection.Row, 4), Cells(Selection.Row, 39)).Copy 'Zeile der markierten Zelle von D(4) bis AM(39) kopieren
Sheets("Tag").Select 'Tabelle "Tag" aufrufen
Range("B2").Select 'Zelle B2 markieren
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True 'Zeiten einfügen (von oben nach unten)
Application.CutCopyMode = False 'Markierungrahmen (vom Kopieren) entfernen
Range("A1").FormulaR1C1 = "Mitarbeiter" 'Zelle A1 beschriften
Range("B1").FormulaR1C1 = "Dienstbeginn" 'Zelle B1 beschriften
Range("A2:B50").Select 'Bereich "A2 bis B50) markieren
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 'gewählten Bereich nach Anfangszeiten sortieren
Range("B1").End(xlDown).Select 'letzte gefüllte Zelle in Spalte B markieren
Do While (ActiveCell.Row > 1) And Not (IsNumeric(ActiveCell)) 'Schleife: Solange die Zeilennummer größer als 1 ist und eine Zahl enthält, passiert folgendes:
Union(ActiveCell, ActiveCell.Offset(0, -1)).ClearContents 'Aktive Zelle und die Zelle links daneben markieren und Inhalte löschen
ActiveCell.Offset(-1, 0).Select 'Die Zelle über der aktiven Zelle markieren
Loop 'Ende der Schleife, wenn eine der Bedingungen aus "Do while" nicht erfüllt ist
Range("D7").Select 'Zelle D7 markieren
End Sub 'Ende des Makros
Ansonsten würd ich nochmal die Eigenschaft des Buttons
checken ;-)
Bye
Nike
Sheets("Tag").Range("A1:B50").ClearContents
Es soll wohl nicht sein, Danke nocmals.
Werner