Neuer Name -> neues WorkSheet
06.10.2008 17:11:00
Manu
kann mir irgendjemand weiterhelfen? bin voll am verzweifeln!!!
Ich möchte gern ein Makro haben wo ich einen Namen den ich in ein Feld schreibe, als neues Blatt angelegt bekomme. Habs folgenderweise mit dem Makrorecorder versucht...
Sub NeuerName
Rows("20:20").Select
Selection.Insert Shift:=xlDown
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Noten").Select
Columns("V:V").Select
Selection.Insert Shift:=xlToRight
Range("V2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]"
Range("V3").Select
ActiveWindow.SmallScroll Down:=39
Range("V66").Select
ActiveCell.FormulaR1C1 = "=RC[-1]"
Range("V67").Select
ActiveWindow.SmallScroll Down:=57
Range("V132").Select
ActiveCell.FormulaR1C1 = "=RC[-1]"
Range("V133").Select
ActiveWindow.SmallScroll Down:=37
ActiveWindow.ScrollRow = 133
ActiveWindow.ScrollRow = 132
ActiveWindow.ScrollRow = 131
ActiveWindow.ScrollRow = 130
ActiveWindow.ScrollRow = 128
ActiveWindow.ScrollRow = 127
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 121
ActiveWindow.ScrollRow = 118
ActiveWindow.ScrollRow = 114
ActiveWindow.ScrollRow = 110
ActiveWindow.ScrollRow = 106
ActiveWindow.ScrollRow = 100
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 86
ActiveWindow.ScrollRow = 83
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 76
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 66
ActiveWindow.ScrollRow = 62
ActiveWindow.ScrollRow = 58
ActiveWindow.ScrollRow = 51
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Sheets("Blanko_MA").Select
Sheets("Blanko_MA").Copy Before:=Sheets(20)
Range("E8").Select
ActiveCell.FormulaR1C1 = "=Noten!R[-3]C[17]"
Range("E8").Select
Selection.AutoFill Destination:=Range("E8:E61"), Type:=xlFillDefault
Range("E8:E61").Select
ActiveWindow.SmallScroll Down:=-12
Range("F8").Select
ActiveCell.FormulaR1C1 = "=Noten!R[61]C[16]"
Range("F8").Select
Selection.AutoFill Destination:=Range("F8:F61"), Type:=xlFillDefault
Range("F8:F61").Select
ActiveWindow.SmallScroll Down:=-10
Range("G8").Select
ActiveCell.FormulaR1C1 = "=Noten!R[127]C[15]"
Range("G8").Select
Selection.AutoFill Destination:=Range("G8:G61"), Type:=xlFillDefault
Range("G8:G61").Select
ActiveWindow.SmallScroll Down:=-1
Range("D13").Select
Selection.Copy
Range("E13:G13").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
Range("D16").Select
Selection.Copy
Range("E16:G16").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
Range("D20").Select
Selection.Copy
Range("E20:G20").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
Range("D30").Select
Selection.Copy
Range("E30:G30").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
Range("D33").Select
Selection.Copy
Range("E33:G33").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
Range("D37").Select
Selection.Copy
Range("E37:G37").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
Range("D42").Select
Selection.Copy
Range("E42:G42").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
Range("D52").Select
Selection.Copy
Range("E52:G52").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
ActiveWindow.SmallScroll Down:=6
Range("D56").Select
Selection.Copy
Range("E56:G56").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
Range("D58").Select
Selection.Copy
Range("E58:G58").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
Range("E54:G55").Select
Selection.ClearContents
Range("E50:G51").Select
Selection.ClearContents
Range("E35:G36").Select
Selection.ClearContents
Range("E28:G29").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-11
Columns("O:V").Select
Selection.EntireColumn.Hidden = False
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Hauptmenue").Select
Range("C20").Select
ActiveCell.FormulaR1C1 = "='Blanko_NeuerName (2)'!Status_Schul"
Range("D20").Select
End Sub
Bei mir funktionierts nicht, aber bei nem Kumpel witzigerweise schon ;)
Weiß vll. jmd was dazu?
Ach so, falls ihr wissen wollt was ich da mache... ich versuche eine Notenübersicht zu erstellen und hätte gern einen Button, der ein neues Sheet anlegt, und mir dann die Daten von meinem Notensheet zieht und sie dem "NeuenNamen"Sheet zuordnet.
Danke schon mal.
C u Manu