Löschen Code ergänzung

Sub Worksheet_Activate()
Dim N As Long
Dim Dx As Range
Dim Mx As Range
Dim Col As Integer
Dim Nx As Range
Dim Zeile As Long
Application.ScreenUpdating = False
With Worksheets("Atribute")
Set Dx = Worksheets("T1").Range("B2")
N = .Cells(Rows.Count, 1).End(xlUp).Row
For Each Nx In .Range("A2:A" & CStr(N))
Application.StatusBar = Nx.Value
For Each Mx In .Range("B1:N1")
Dx.Offset(Col, -1).Value = Nx.Value
Dx.Offset(Col, 0).Value = Mx.Value
Dx.Offset(Col, 1).Value = Mx.Offset(Nx.Row - 1, 0).Value
Col = Col + 1
Next
Next
Application.ScreenUpdating = True
End With
End Sub