Forumbeitrag
Excel-Version des Fragestellers:
2022
Erfahrungslevel des Fragestellers:
Basiskenntnisse in Excel
Hallo,
falls ich es richtig verstanden habe so?
Option Explicit
Sub NewSheet()
Dim oldwks As Worksheet, newWks As Worksheet, Name$, Zellen As Range
Name = InputBox("Bitte Blattnamen vergeben", "Abfrage Blattnamen")
Set oldwks = Tabelle6
Set newWks = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
oldwks.Range("A1").CurrentRegion.Copy
newWks.Range("A1").PasteSpecial (xlAll)
With newWks
Set Zellen = .Range("A1,J1,S1,AB1,AK1,AT1,BC1,BL1,BU1,CD1,CM1,CV1")
.Name = Name
.Hyperlinks.Add Anchor:=Zellen, Address:="", SubAddress:=.Name & "!DO1"
Zellen.Interior.Color = RGB(146, 208, 80)
End With
With Zellen
.Interior.Color = RGB(146, 208, 80)
.HorizontalAlignment = xlCenter
End With
End Sub
Gruß Uwe