VBA Zeile ausschneiden und in anderes Tabellenblatt einfügen

Question

Guten Abend,

habe ein Tabelle ( Agenda ) und Tabellenblätter mit (a,i und s-Werten)
Nun soll die Spalte B in Agenda verglichen werden.
Wenn dort im Pfad ein "s" steht dann die Zeile ausschneiden und in Tabellenblatt (swerte) eingefügt werden, dass gleiche mit a und i Werten.
Muss dass ein Do-while schleife sein? er muss es solange machen (usedrange.count)

Wer kann mir helfen?

Siehe auch Datei


http://www.file-upload.net/download-2243956/Test.xls.html

Answer 1

HAllo,

eine Lösung wäre z.B. die nachfolgende.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Sub Verschieben()
Dim lngRow As Long
Dim lngFirstRow As Long
Application.ScreenUpdating = False
For lngRow = Sheets("agenda").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row To 4 Step -1
If LCase(Sheets("agenda").Cells(lngRow, 2)) = LCase("a") Then
Sheets("agenda").Rows(lngRow).Copy
Sheets("awerte").Cells(Sheets("awerte").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row, 1).PasteSpecial
Sheets("agenda").Rows(lngRow).Delete Shift:=xlUp
ElseIf LCase(Sheets("agenda").Cells(lngRow, 2)) = LCase("s") Then
Sheets("agenda").Rows(lngRow).Copy
Sheets("swerte").Cells(Sheets("swerte").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row, 1).PasteSpecial
Sheets("agenda").Rows(lngRow).Delete Shift:=xlUp
ElseIf LCase(Sheets("agenda").Cells(lngRow, 2)) = LCase("i") Then
Sheets("agenda").Rows(lngRow).Copy
Sheets("iwerte").Cells(Sheets("iwerte").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row, 1).PasteSpecial
Sheets("agenda").Rows(lngRow).Delete Shift:=xlUp
End If
Next lngRow
End Sub
Hier werden die Buchstaben in Spalte B abgefragt und dann die Datensätze in die entsprechenden Tabellenblätter kopiert.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]