Option Explicit

Public Sub Beispiel()
  
  Dim blnEE As Boolean
  Dim blnSU As Boolean
  
  blnEE = Application.EnableEvents
  blnSU = Application.ScreenUpdating
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  
  On Error GoTo ErrHandler
  
  Dim wksQuelle As Excel.Worksheet
  Dim wksZiel As Excel.Worksheet
  Dim rngQuelle As Excel.Range
  Dim rngZiel As Excel.Range
  Dim rngZeile As Excel.Range
  
  Set wksQuelle = Worksheets("Tabelle1")  ' <- anpassen
  Set wksZiel = Worksheets("Tabelle2")    ' <- anpassen
  
  ' Der Bereich der vollständigen Tabelle
  Set rngQuelle = wksQuelle.Range("A1").CurrentRegion ' <- ggf. Bereich (hier 'A1') anpassen
  
  If rngQuelle.Columns.Count < 3 Then
    Call MsgBox("Tabelle muss mindestens 3 Spalten umfassen." & vbNewLine & _
                "Vorgang wird abgebrochen.", _
                vbExclamation)
    GoTo SafeExit
  End If
  
  ' obere, linke Ecke (=Zelle) der Ausgabe
  Set rngZiel = wksZiel.Range("B2") ' <- ggf. Bereich (hier 'B2') anpassen
  
  'Kopfzeile schreiben
  rngZiel.Resize(ColumnSize:=3).Value = Array("Teil", "LO", "MELDE")
  Set rngZiel = rngZiel.Offset(RowOffset:=1)
  
  With rngQuelle.Resize(RowSize:=rngQuelle.Rows.Count - 1).Offset(RowOffset:=1)
    
    For Each rngZeile In .Rows
      
      ' Teil schreiben
      rngZiel.Resize(RowSize:=rngZeile.Cells.Count - 2).Value = rngZeile.Cells(1).Value
      ' LO schreiben
      Call rngZeile.Resize(ColumnSize:=rngZeile.Cells.Count - 2).Offset(ColumnOffset:=1).Copy
      Call rngZiel.Offset(ColumnOffset:=1).PasteSpecial(xlPasteValues, Transpose:=True)
      'MELDE schreiben
      rngZiel.Offset(ColumnOffset:=2).Value = rngZeile.Cells(rngZeile.Cells.Count).Value
      
      ' an die Stelle für die nachfolgende Ausgabe springen
      Set rngZiel = rngZiel.Offset(RowOffset:=rngZeile.Cells.Count - 2)
    Next
    
  End With
  
  If Not ActiveSheet Is Nothing Then
    If Not rngZiel.Worksheet Is ActiveSheet Then
      Set wksQuelle = ActiveSheet ' aktuell sichtbare Arbeitsblatt merken
      rngZiel.Worksheet.Activate
      rngZiel.Select
      Call wksQuelle.Activate ' das zuvor sichtbare Arbeitsblatt wieder anzeigen
    Else
      rngZiel.Select
    End If
  End If
  
  GoTo SafeExit
ErrHandler:
  Call MsgBox(Err.Description, vbCritical, "Fehler " & Err.Number)
  
SafeExit:
  Application.CutCopyMode = False
  Application.EnableEvents = blnEE
  Application.ScreenUpdating = blnSU
  
End Sub