Übertrag/Sortierung in Tabelle

[Kiter1988]

Hallo, das klappt ja schonmal wunderbar.

Ich befürchte aber, dass nun mein If - Then Code nicht mehr funktioniert.
Die Daten werden zwar in die Tabelle geschrieben, aber die erneute Eingabe nicht nach unten (x1Down) versetzt.

Code:

Sub Einfügen()
Dim iSpalte As Integer
Dim Datum As String, Standort As String, Name As String, Material As String, Stück As String
Worksheets("Übersicht").Select
Datum = Range("E5")
Standort = Range("F5")
Name = Range("G5")
Stk = Range("M5")
Worksheets("Übersicht").Select
Worksheets("Übersicht").Range("A26").Select
If Worksheets("Übersicht").Range("A26").Offset(1, 0) <> "" Then
Worksheets("Übersicht").Range("A26").End(xlDown).Select
End If
ActiveCell.Offset(0, 0).Value = Datum
ActiveCell.Offset(0, 1).Value = Standort
ActiveCell.Offset(0, 2).Value = Name
Select Case Range("H5").Value
Case "Spalte1": iSpalte = 3
Case "Spalte2": iSpalte = 4
Case "Spalte3": iSpalte = 5
'... usw.
End Select
ActiveCell.Offset(0, iSpalte).Value = Stk
End Sub

 ich glaube fast, dass "iSpalte" mit ins "If" muss.

[Kuwer]

Hallo,

Sub Einfuegen()

Dim iSpalte As Long, iZeile As Long

With Worksheets("Übersicht")

  iZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

  .Cells(iZeile, 1).Resize(, 3).Value = .Range("E5:G5").Value

  Select Case .Range("H5").Value

    Case "Spalte1": iSpalte = 4

    Case "Spalte2": iSpalte = 5

    Case "Spalte3": iSpalte = 6

  '... usw.

  End Select

  .Cells(iZeile, iSpalte).Value = .Range("M5").Value

End With

End Sub

Gruß Uwe