Option
Explicit
Sub
Blatt_Kopieren_Name_Neu()
Dim
wksCat
As
Excel.Worksheet
Dim
wksSrc
As
Excel.Worksheet
Dim
wksNew
As
Excel.Worksheet
Dim
n
As
Long
Set
wksCat = Worksheets(
"Categories"
)
Set
wksSrc = Worksheets(
"Sample Sheet"
)
n = 1
Do
While
wksCat.Cells(n,
"A"
).Text <>
""
wksSrc.Copy After:=Sheets(2)
Set
wksNew = Sheets(2).
Next
wksNew.Name = wksCat.Cells(n,
"A"
).Text
wksNew.Range(
"B3"
).Formula =
"=VLOOKUP(A3,Toolbox!$1:$1048576,"
& 2 + n &
",FALSE)"
n = n + 1
Loop
End
Sub