Re: kopieren von zellinhalten
29.01.2003 21:02:39
Chris
Hallo SvenOption Explicit
Private Sub CommandButton1_Click()
Dim BlName As String
Dim Zeile As Double, i As Double
On Error GoTo errorhandler
Application.ScreenUpdating = False
BlName = ActiveCell
Zeile = ActiveCell.Row
If ActiveCell.Column <> 1 Then
MsgBox "Die selektierte Zelle befindet sich nicht in Spalte A."
Exit Sub
End If
If BlName = "" Then
MsgBox "Es wurde eine leere Zelle selektiert."
Exit Sub
End If
For i = 1 To Worksheets.Count
If Sheets(i).Name = BlName Then
MsgBox ("Die ausgewählte Zelle existiert bereits als Blatt, weshalb der Vorgang abgebrochen wurde.")
Exit Sub
End If
Next i
Sheets("Stammblatt").Visible = True
Sheets("Stammblatt").Copy After:=Sheets(Sheets.Count)
Sheets("Stammblatt (2)").Select
Sheets("Stammblatt (2)").Name = BlName
Sheets("Stammblatt").Visible = False
Sheets(BlName).Range("D5") = Sheets("PersDaten").Cells(Zeile, 2)
Sheets(BlName).Range("D8") = Sheets("PersDaten").Cells(Zeile, 3)
Application.ScreenUpdating = True
Exit Sub
errorhandler:
MsgBox "Es ist ein Fehler aufgetreten. Mögliche Ursache: Die selektierte Zelle enthält Sonderzeichen, welche nicht als Blattnamen verwendet werden können."
Application.DisplayAlerts = False
Sheets("Stammblatt (2)").Delete
Application.DisplayAlerts = True
Sheets("Stammblatt").Visible = False
End Sub
Viel Spass damit und Gruss
Chris