Wie konvertiere ich eine Tabelle in eine Spalte?

Ich habe eine Tabelle mit Einkaufslisten, die so aussieht:

(a1) gemüse (b1) menge (c1) obst (d1) menge (e1) getränke (f1) menge

und in Zeile 2 und so weiter gibt es die Liste. also will ich nur das sehen, was ich in einer reihe markiere.

Beispiel: im Gemüse: 3 kg Tomaten, Gurke 0, 1 kg Möhren.
also in der einen spalte sehe ich den titel (gemüse) und 3 kg tomaten und karotten 1 kg (ohne gurke) und so weiter ...

Sie können es mit VBA oder FORMEL machen und Sie können es in einem anderen Blatt machen ... was auch immer Sie wollen.

Wie Sie sehen können, sind die Gurken, Äpfel und Orangen NICHT in der Tabelle rechts aufgeführt.

Dieser VBA- Code sollte funktionieren:

Public Sub summary()
    Dim wk As Workbook
    Dim ws, ws1 As Worksheet
    Set wk = ThisWorkbook
    Set ws = wk.Sheets("Sheet1")
    Set ws1 = wk.Sheets("Sheet2")
    ws1Columns = 1
    ws1Rows = 1
    maxColumns = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 1 To maxColumns Step 2
        theRows = 1
        theCell = ws.Cells(theRows, i)
        theCell2 = ws.Cells(theRows, i + 1)
        While theCell <> ""
            If theCell2 <> "" Then
                ws1.Cells(ws1Rows, ws1Columns) = theCell
                ws1.Cells(ws1Rows, ws1Columns + 1) = theCell2
                ws.Cells(theRows, i).Copy
                ws1.Cells(ws1Rows, ws1Columns).PasteSpecial Paste:=xlPasteFormats
                ws.Cells(theRows, i + 1).Copy
                ws1.Cells(ws1Rows, ws1Columns + 1).PasteSpecial Paste:=xlPasteFormats
                ws1Rows = ws1Rows + 1
            End If
            theRows = theRows + 1
            theCell = ws.Cells(theRows, i)
            theCell2 = ws.Cells(theRows, i + 1)
        Wend
    Next i
End Sub

Öffnen Sie VBA / Macros mit ALT + F11, fügen Sie unter ThisWorkbook ein neues Modul hinzu und fügen Sie diesen Code ein.

Führen Sie das Makro aus, und wenn sich die ursprünglichen Daten in befinden, Sheet1wird das Endergebnis in angezeigt Sheet2.