AW: Zeilen in Spalten darstellen
22.11.2019 10:23:35
Nepumuk
Hallo Peter,
teste mal:
Option Explicit
Public Sub Tabelle_umstellen()
Dim lngInputRow As Long, lngOutputRow As Long, lngOutputColumn As Long
Dim objInputWorksheet As Worksheet, objOutputWorksheet As Worksheet
Application.ScreenUpdating = False
Set objInputWorksheet = ActiveSheet
Set objOutputWorksheet = ThisWorkbook.Worksheets.Add(After:=ActiveSheet)
objOutputWorksheet.Range("A1:F1").Value = Array("Artikel", "Zeichnung_1", _
"Zeichnung_2", "Zeichnung_3", "Zeichnung_4", "Zeichnung_5")
lngOutputRow = 1
With objInputWorksheet
For lngInputRow = 4 To .Cells(.Rows.Count, 2).End(xlUp).Row 'Startzeile anpassen !!!
If Not IsEmpty(.Cells(lngInputRow, 1).Value) Then
lngOutputColumn = 2
lngOutputRow = lngOutputRow + 1
objOutputWorksheet.Cells(lngOutputRow, 1).Value = .Cells(lngInputRow, 1).Value
objOutputWorksheet.Cells(lngOutputRow, 2).Value = .Cells(lngInputRow, 2).Value
Else
lngOutputColumn = lngOutputColumn + 1
objOutputWorksheet.Cells(lngOutputRow, lngOutputColumn).Value = .Cells(lngInputRow, 2).Value
End If
Next
End With
objOutputWorksheet.Columns("A:F").AutoFit
Set objInputWorksheet = Nothing
Set objOutputWorksheet = Nothing
Application.ScreenUpdating = True
End Sub
Gruß
Nepumuk