Zeilen in Spalten darstellen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

Hallo Peter,
... für z.B. max 996 Datensätze so: Formel D4 nach unten und E4 zusätzlich auch nach rechts weit genug ziehend kopieren:

Arbeitsblatt mit dem Namen 'Tabelle2'
	A	B	C	D	E	F	G	H	I
3	Artikel	Zeichnung		Artikel	Zeichnung_1	Zeichnung_2	Zeichnung_3	Zeichnung_4	Zeichnung_5
4	4711	asset_1094334.jpg		4711	asset_1094334.jpg	asset_1094336.jpg	asset_1149512.jpg
5		asset_1094336.jpg		4712	asset_1094339.jpg	asset_1094340.jpg
6		asset_1149512.jpg		4713	asset_1094334.jpg	asset_1094836.jpg	asset_1149612.jpg	asset_1149614.jpg
7	4712	asset_1094339.jpg		4720	asset_1094334.jpg	asset_1094336.jpg	asset_1149512.jpg
8		asset_1094340.jpg		4727	asset_1094334.jpg	asset_1094336.jpg	asset_1149512.jpg
9	4713	asset_1094334.jpg		4730	asset_1094334.jpg	asset_1094336.jpg	asset_1149512.jpg
10		asset_1094836.jpg
11		asset_1149612.jpg
12		asset_1149614.jpg
13	4720	asset_1094334.jpg
14		asset_1094336.jpg
15		asset_1149512.jpg
16	4727	asset_1094334.jpg
17		asset_1094336.jpg
18		asset_1149512.jpg
19	4730	asset_1094334.jpg
20		asset_1094336.jpg
21		asset_1149512.jpg
22

Zelle	Formel
D4	=WENNFEHLER(INDEX(A:A;AGGREGAT(15;6;ZEILE(A$4:A$999)/(A$4:A$999>"");ZEILE()-ZEILE(A$3)));"")
E4	=WENN(D4="";"";WENN(SPALTE()-SPALTE($E3)&gt=WENN($D5="";999;VERGLEICH($D5;$A:$A;0))-VERGLEICH($D4;$A:$A;0);""; INDEX($B:$B;VERGLEICH($D4;$A:$A;0)+SPALTE()-SPALTE($E3))&""))

Verwendete Systemkomponenten: [Windows (32-bit) NT 6.02] MS Excel 2010

Gruß Werner
.. , - ...

Sub test() With Cells(3, 1).CurrentRegion With .Columns(.Columns.Count + 1) .FormulaR1C1 = "=RC2&IF(R[1]C1="""","";""&R[1]C,"""")" .Formula = .Value .TextToColumns Destination:=.Cells(1, 1), _ DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _ Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False End With .Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete End With End Sub

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen in Spalten darstellen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread