AW: Name abfragen und Erzeugung eines neuen Tabellenbl
29.07.2010 14:57:42
ajbl
Hallo Heiko,
1. funzt problemlos, allerdings bei den Zeilen, die ich mit einem Stern versehen habe, kommt ein Kompilierungsfehler, ich habe sie deaktiviert, ist es ok so?
2. ich würde gerne einen 2. Makro in deinem Makro einbinden (
Sub Create_New_Sheets()). Bei diesem Makro werden von einem Musterblatt die Daten in das _
neuerzeugte Tabellenblatt hineinkopiert. Wie kann ich dieses Makro einbinden?
Danke
Adrian
Sub Test()
Dim strSheetName As String, strHelp As String
strSheetName = InputBox("Bitte geben Sie den Tabellenblattnamen an!", " Tabellenblattname ?", " _
_Name ?")
If Len(strSheetName) > 0 Then
On Error Resume Next
strHelp = CStr(ActiveWorkbook.Worksheets(strSheetName).Range("A1"))
If Err.Number = 0 Then
On Error GoTo 0
* ' If MsgBox("Ein Sheet mit dem Namen " & strSheetName & " gibt es schon! ÜBERSCHREIBEN ? _
? _
", vbCritical + vbYesNo) = vbNo Then
Exit Sub
Else
On Error GoTo 0
Application.DisplayAlerts = False
*' ActiveWorkbook.Worksheets(strSheetName).Delete
Application.DisplayAlerts = True
End If
End If
On Error GoTo 0
ActiveWorkbook.Worksheets.Add.Name = strSheetName
ActiveWorkbook.Worksheets("xyz").Range("A1") = strSheetName
ActiveWorkbook.Worksheets("xyz").Range("B1").Formula = "=" & strSheetName & "!A1"
*'End If
End Sub
Sub Create_New_Sheets()
Dim Zelle As Integer
Set NewSheet = Worksheets.Add
NewSheet.Name = "Neu"
Sheets("Neu").Move After:=Worksheets(Worksheets.Count)
Sheets("Muster").Select
Cells.Select
Selection.Copy
Sheets("Neu").Select
ActiveWorkbook.Sheets("Neu").Tab.ColorIndex = 6
ActiveSheet.Paste
Range("A1").Select
Sheets("Gesamt").Select
Range("J10").Select
For i = 1 To 60
If ActiveCell.Value "" Then ActiveCell.Offset(1, 0).Select Else Exit For
Next i
ActiveCell.FormulaR1C1 = "=+'Neu'!R17C5"
Selection.NumberFormat = "#,##0.00"
End Sub