Hallo zusammen,
ich bin VBA-Einstgeiger und habe mir eine Datenbank aufgebaut.
In einer Eingabeliste habe ich Datenbestände drinnen, die ich per Button klick einzeln sortieren möchte. Soweit funktioniert auch alles einwandfrei.
BIS auf dass, wenn ich Spalte 25 "nein" reinschreibe schneidet er mir zwar die komplette Zeile aus
und fügt Sie mir in die Tabelle "Tol1" ein aber überschreibt mir die voherigen Datenbestände.
Die einzelnen Zeilen sind nicht immer identisch gefüllt, Bsp.
In Zeile 1 ist dann A - B mit daten gefüllt
In Zeile 2 ist A und D nur mit daten gefüllt usw .... dennoch sollten beide Zeilen bei der Bedingung Y="nein" in die Tabelle "Tol1" eingefügt werden.
kann mir jemand sagen wo mein Fehler ist?
Danke im Vorraus!!!!!
Padoom
Option Explicit
Sub Makro1()
Dim lngLetzteZeile As Long
Dim rngZelle As Range
Dim wksZiel As Worksheet, wksZiel2 As Worksheet, wksZiel3 As Worksheet
Dim wksZiel4 As Worksheet, wksZiel5 As Worksheet
Dim lngSpalte As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
Set wksZiel = ActiveWorkbook.Worksheets("WV1")
Set wksZiel2 = ActiveWorkbook.Worksheets("SM")
Set wksZiel3 = ActiveWorkbook.Worksheets("NE1")
Set wksZiel4 = ActiveWorkbook.Worksheets("TOL1")
Set wksZiel5 = ActiveWorkbook.Worksheets("KOT")
For Each rngZelle In Selection.Cells
If rngZelle.Row >= 8 Then
If rngZelle.Row <= 9999 Then
lngSpalte = rngZelle.Column
Select Case lngSpalte
Case 5, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31, 33, 35, 37, 39, 41, _
43, 45, 47, 49, 52, 54, 56
If rngZelle.Value <> "" Then
rngZelle.Offset(0, 1).Value = Date
Else
rngZelle.Offset(0, 1).ClearContents
End If
End Select
If lngSpalte = 13 Then
If rngZelle.Value = "nein" Then
lngLetzteZeile = wksZiel5.Cells(wksZiel5.Rows.Count, 13).End( _
xlUp).Row
Range(Cells(rngZelle.Row, 1), Cells(rngZelle.Row, 70)).Copy _
Destination:=wksZiel5.Cells(lngLetzteZeile + 1, 1)
Rows(rngZelle.Row).Delete
End If
ElseIf lngSpalte = 25 Then
If rngZelle.Value = "ja" Then
lngLetzteZeile = wksZiel.Cells(wksZiel.Rows.Count, 13).End(xlUp).Row
Range(Cells(rngZelle.Row, 1), Cells(rngZelle.Row, 70)).Copy _
Destination:=wksZiel.Cells(lngLetzteZeile + 1, 1)
Rows(rngZelle.Row).Delete
ElseIf rngZelle.Value = "nein" Then
lngLetzteZeile = wksZiel4.Cells(wksZiel4.Rows.Count, 13).End( _
xlUp).Row
Range(Cells(rngZelle.Row, 1), Cells(rngZelle.Row, 70)).Copy _
Destination:=wksZiel4.Cells(lngLetzteZeile + 1, 1)
Rows(rngZelle.Row).Delete
End If
ElseIf lngSpalte = 17 Then
If rngZelle.Value = "x" Then
lngLetzteZeile = wksZiel3.Cells(wksZiel3.Rows.Count, 13).End( _
xlUp).Row
Range(Cells(rngZelle.Row, 1), Cells(rngZelle.Row, 70)).Copy _
Destination:=wksZiel3.Cells(lngLetzteZeile + 1, 1)
Rows(rngZelle.Row).Delete
End If
End If
End If
End If
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End SubP.s. ich arbeite mit Excel 2003
Beitrag wurde zuletzt am 14.01.10 um 13:55:26 editiert. |
Forenübersicht Suchen Forumsregeln
Sie sind aktuell nicht angemeldet.
