Frage an Oberschlumpf
Udo
Hallo Oberschlumpf
Besten Dank für Deine Hilfe - ich habe aber Einbindungsprobleme, habe deshalb mein Makro untenstehend aufgeführt. Ich öffne bereits ein Tabellenblatt, da ich eine Kopie brauche - Du öffnest auch eines. Mein Referenzname heisst MSR_Nummer; ich stelle das neue Blatt jeweils an den Anfang der Registerblätter.
Kannst Du mir weiterhelfen? Habe die Positionen mit ! hervorgehoben.
Sub Bestellblatt_erstellen()
' Bestellblatt_erstellen Makro
' Makro am 29.03.2004 von aufgezeichnet
Application.ScreenUpdating = False
Sheets("Menü-Übersicht").Select
ActiveSheet.Unprotect
Sheets("Grundtabelle").Select
ActiveSheet.Unprotect
! Sheets("Grundtabelle").Select
! Sheets("Grundtabelle").Copy Before:=Sheets(1)
! Sheets(1).Select
! Titel = Sheets(1).Range("MSR_Nummer").Value
! Sheets(1).Name = Titel
Columns("C:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Columns("l:BE").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("c:c").Select '5. Spalte Markieren
Selection.SpecialCells(xlCellTypeBlanks).Select 'Alle Leerzellen Markieren
Selection.EntireRow.Delete 'Von den ausgewählten Zellen die ganze Zeile löschen
Cells.Select
Selection.FormatConditions.Delete
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Shapes("Button 2").Select
Selection.Characters.Text = "Bestellung per E-Mail"
With Selection.Characters(Start:=1, Length:=21).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 6
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 5
End With
Selection.OnAction = "E_Mail_Versand"
Columns("B:G").Select
ActiveSheet.PageSetup.PrintArea = "$B:$H"
Range("B3").Select
Sheets("Menü-Übersicht").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Grundtabelle").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub
Nochmals recht herzlichen Dank für hierhin.
Gruss Udo