Blatt kopieren
Werner
ich möchte das Tabellenblatt1 kopieren undvor der Tabelle "Mitarbeiterablage" einfügen.Es sind noch
weidere Befehle drinn, doch das Problem ist am anfan des Makros, den es wird ein Laufzeitfehler angezeigt der in der Zeile: Sheets("Tabelle1").Copy Before:=Sheets("Mitarbeiterablage")
sein muß den diese Zeile ist gelb hinterlegt.
Public Function SheetTest(strName As String) As Boolean
On Error Resume Next
SheetTest = Not Sheets(strName) Is Nothing
End Function
Private Sub CommandButtonTabelle1_Click()
Dim vLinks, ii As Integer, strB As String
Application.EnableEvents = False
Sheets("Tabelle1").Copy Before:=Sheets("Mitarbeiterablage")
ActiveSheet.Shapes("CommandButtonMA1").Left = Range("F1").Left 'CommandButton Positionieren
ActiveSheet.Shapes("CommandButtonMA1").Top = Range("F1").Top
strB = ActiveSheet.Cells(2, 2) ' Blatt umbenennen
If SheetTest(strB) Then
Do
MsgBox "Das kopierte Blatt konnte in " & ActiveWorkbook.Name & _
" nicht umbenannt werden." & vbLf & vbLf & "der Name " & strB & _
" war bereits vorhanden.", vbExclamation, "weise hin..."
strB = InputBox("Bitte geben Sie einen neuen Namen ein!!") 'da Name schon vorhanden, neuen _
Namen eingeben
Loop While SheetTest(strB)
End If
ActiveSheet.Name = strB
ActiveSheet.Cells(2, 2) = strB
ActiveSheet.Name = strB
Sheets("Tabelle1").Range("B3,B4,B5,E2,E3,K9:O47,G10:I10,E15:G18,J14,V11:V22,AA11:AC22,P14:P17"). _
ClearContents
Range("A6") = 2
Range("A7") = 1
Sheets("Startcenter").Select
Range("D12") = "Mitarbeiter 1"
Exit Sub
Application.EnableEvents = True
End Sub
Wer kann Helfen?
Gruß Werner
Anzeige