Vba verschieben in tabellenblatter

Thomas · 2017-09-13T12:01:35+00:00

Guten morgen:-) ich hätte da mal ein anliegen. in mein Tabellenblatt Daten steht von Spalte A bis M Daten drin. Ab zeile 7 Jetzt möchte ich das wenn in Spalte K das Wort ( Dropdown) Schrauben vorkommt soll die gabze zeile in das Tabellenblatt Werkzeug ab zeile2 eingefügt werden und vom Tabellenblatt ydaten gelöscht und nachgerutscht werden. Wenn das Wort Wolle vorkommt dann ins Tabellenblatt Textil und wenn das Wort Cola borkommt ins Tabellenblatt getränke. Das alles soll über einen Button angesteuert werden. Ist sowas möglich? danke

Servus,
z.B. so:


Sub sortieren()
Dim wsWerkzeug As Worksheet
Dim wsTextil As Worksheet
Dim wsGetränke As Worksheet
Dim ws As Worksheet
Dim intLZ As Integer
Dim i As Integer
Set ws = ThisWorkbook.Sheets("Tabelle1")
Set wsWerkzeug = ThisWorkbook.Sheets("Werkzeug")
Set wsTextil = ThisWorkbook.Sheets("Textil")
Set wsGetränke = ThisWorkbook.Sheets("Getränke")
intLZ = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = intLZ To 2 Step -1
Select Case ws.Cells(i, 11).Value
Case Is = "Schrauben"
ws.Rows(i).Copy Destination:=wsWerkzeug.Cells((wsWerkzeug.Cells(Rows.Count, 1).End(xlUp). _
Row + 1), 1)
ws.Rows(i).EntireRow.Delete
Case Is = "Wolle"
ws.Rows(i).Copy Destination:=wsTextil.Cells((wsTextil.Cells(Rows.Count, 1).End(xlUp).Row +  _
1), 1)
ws.Rows(i).EntireRow.Delete
Case Is = "Cola"
ws.Rows(i).Copy Destination:=wsGetränke.Cells((wsGetränke.Cells(Rows.Count, 1).End(xlUp). _
Row + 1), 1)
ws.Rows(i).EntireRow.Delete
Case Else
MsgBox "Benennung nicht bekannt"
End Select
Next i
Set ws = Nothing
Set wsWerkzeug = Nothing
Set wsTextil = Nothing
Set wsGetränke = Nothing
End Sub

Grüße, Bernd

Hallo Thomas,
ich glaube wir haben da ein wenig aneinander vorbei gesprochen. Du willst dass eine Meldung ausgegeben wird, wenn keine Daten übertragen werden, weil die entsprechenden Werte in Spalte K nicht vorhanden sind.
Dann so:

Option Explicit
Public Sub Verschieben()
Dim loLetzteQ As Long
Dim loLetzteZ As Long
Dim i As Long
Dim wsZiel As Worksheet
Dim strTreffer As String
Dim boSchalter As Boolean
With Worksheets("Daten")
loLetzteQ = .Cells(.Rows.Count, 11).End(xlUp).Row
For i = loLetzteQ To 7 Step -1
Select Case .Cells(i, 11).Value
Case "Schrauben"
Set wsZiel = Worksheets("Werkzeug")
strTreffer = .Cells(i, 11).Value
boSchalter = True
Case "Wolle"
Set wsZiel = Worksheets("Textil")
strTreffer = .Cells(i, 11).Value
boSchalter = True
Case "Cola"
Set wsZiel = Worksheets("Getränke")
strTreffer = .Cells(i, 11).Value
boSchalter = True
Case Else
End Select
If Not wsZiel Is Nothing Then
If .Cells(i, 11).Value = strTreffer Then
loLetzteZ = wsZiel.Cells(wsZiel.Rows.Count, 1).End(xlUp).Row + 1
Application.ScreenUpdating = False
.Rows(i).Copy
wsZiel.Cells(loLetzteZ, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
.Rows(i).Delete shift:=xlUp
End If
End If
Next i
If Not boSchalter Then
MsgBox "Keine Daten für Übertrag vorhanden."
End If
End With

Gruß Werner

Vba verschieben in tabellenblatter

Forumthread: Vba verschieben in tabellenblatter

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Vba verschieben in tabellenblatter

Forumthread: Vba verschieben in tabellenblatter

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread