Werte auf neues Blatt mit Makro

Hallo,
ich habe ein Makro aufgeszeichnet bei dem eine Tabelle auf Blatt 1 in ein neues Blatt kopiert wird. Anschließend werden die Werte noch aus der ersten Tabelle gelöscht und das neue Blatt geschützt.
Problem: Das vorhergegangene Blatt wird irgendwie auch überschrieben und eine art Bild eingefügt. Schön wäre es noch wenn das neue Blatt immer das aktuelle Datum als Namen hat.
Vielen Dank füe eventuelle Hilfe.
Makro:

Sub t()
Dim letzteZeile As Long
letzteZeile = Range("A65536").End(xlUp).Row + 1
If letzteZeile

Sub nachdatum()
' nachdatum Makro
ActiveWindow.SmallScroll Down:=6
Range("A6:K32").Select
Range("K32").Activate
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range("J6:J32" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Range("A6:K32")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=-12
End Sub

Sub datum2()
' datum2 Makro
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range("J6:J32" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Range("A6:K32")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=-15
Range("M16").Select
End Sub

Sub fertig()
' fertig Makro
ActiveWindow.SmallScroll Down:=9
Range("A4:L33").Select
Range("L33").Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.CheckBoxes.Add(1161, 266.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 284.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 302.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 320.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 338.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 356.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 374.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 392.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 410.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 428.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 446.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 464.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 482.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 500.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 518.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 536.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 554.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 572.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 590.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 626.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 608.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 608.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 644.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 662.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 680.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 698.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 716.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 734.25, 31.5, 16.5).Select
ActiveSheet.Paste
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
Columns("L:L").EntireColumn.AutoFit
Range("M2").Select
Columns("K:K").EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=0
Sheets("Tabelle1").Select
ActiveWindow.SmallScroll Down:=-6
Range("A6:K33").Select
Range("K33").Activate
Application.CutCopyMode = False
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-18
Range("J2").Select
End Sub

Sub Makro9()
' Makro9 Makro
ActiveWindow.SmallScroll Down:=6
Range("A4:L33").Select
Range("L33").Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.CheckBoxes.Add(1161, 266.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 284.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 302.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 320.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 338.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 356.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 374.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 392.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 410.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 428.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 446.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 464.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 482.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 500.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 518.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 536.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 554.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 572.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 590.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 626.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 608.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 608.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 644.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 662.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 680.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 698.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 716.25, 31.5, 16.5).Select
ActiveSheet.CheckBoxes.Add(1161, 734.25, 31.5, 16.5).Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=3
Range("A3:K29").Select
Range("K29").Activate
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Tabelle1").Select
ActiveWindow.SmallScroll Down:=-12
Range("A6:K32").Select
Range("K32").Activate
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-6
Range("J2").Select
Sheets("Tabelle9").Select
Range("A3").Select
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro9() Dim WS1 As Worksheet, WS2 As Worksheet, i As Currency Set WS1 = Worksheets("Tabelle1") Set WS2 = Sheets.Add WS2.Name = Date WS2.Range("A1:L30").Value = WS1.Range("A4:L33").Value WS2.Columns("F:K").EntireColumn.AutoFit For i = 266.25 To 734.25 Step 18 WS2.CheckBoxes.Add(1161, i, 31.5, 16.5).Select Next i WS2.Protect WS1.Range("A6:K33").ClearContents End Sub

Sub Makro9() Dim WS1 As Worksheet, WS2 As Worksheet, i As Currency Set WS1 = Worksheets("Tabelle1") Set WS2 = Sheets.Add WS2.Name = Date WS1.Range("A4:L33").Copy WS2.Range("A1").Select WS2.Paste Selection.PasteSpecial Paste:=xlPasteColumnWidths For i = 266.25 To 734.25 Step 18 WS2.CheckBoxes.Add(1161, i, 31.5, 16.5).Select Next i WS1.Range("A6:K33").ClearContents WS1.Protect WS2.Protect End Sub

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

201 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Werte auf neues Blatt mit Makro

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

201 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread