Hallo
versuch es so
Sub Transformieren()
Dim Z1 As Integer, Sp1 As Integer, SP As Integer
Dim LR As Long, LC As Integer, i As Long, ZN As Long
Dim TB1 As Worksheet, TB2 As Worksheet
Set TB1 = Sheets("Tabelle1")
Set TB2 = Sheets.Add(After:=Sheets(Sheets.Count))
Z1 = 3 'erste Zeile mit Daten
Sp1 = 4 ' Ab Spalte D
LR = TB1.Cells(TB1.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
LC = TB1.Cells.SpecialCells(xlCellTypeLastCell).Column 'Letzte Spalte des gesamten Blattes
With TB2
.Cells(1, 1) = "QB Item"
.Cells(1, 2) = "Description"
.Cells(1, 3) = "Sales Price"
ZN = 1 'Neue Zeilennummer
For i = Z1 To LR
For SP = Sp1 To LC
.Cells(ZN + 1, 1) = TB1.Cells(i, 2) & Format(TB1.Cells(2, SP), "00")
.Cells(ZN + 1, 2) = TB1.Cells(i, 3) & " " & TB1.Cells(2, SP) & "oz"
.Cells(ZN + 1, 3) = TB1.Cells(i, SP)
ZN = ZN + 1
Next
Next
End With
End Sub
|