Kleine :-) Änderung
18.05.2006 15:35:36
Ralf
ich habe hier eine ganz tolle VBA Prozedur (s.unten), die auch super
funktioniert, d.h. es gibt eine Tabelle Spalte A bis L
und diese Prozedur sucht in der Spalte H nach einem X, (wenn
ich sie laufen lasse!), und markiert (rot) und kopiert dann die entspr. Zeilen
und zwar von Spalte A bis L in die Mappe Archiv und setzt noch
in der Spalte danach das aktuelle Datum.
Nun meine Frage: kann man diesen Code auch so umstellen, dass das
Kopieren sofort nach Eingabe des X vorgenommen wird und zwar nur dann,
wenn der Wert in Spalte E nicht schon vorhanden ist ( der darf nämlich nur einmal vorkommen :-)
Viele Grüße
Ralf
Sub X_Archivieren()
Application.ScreenUpdating = False
Dim Suchbereich As Range, Daten As Range, Finden As Range
Dim wks1 As Worksheet, Archiv As Worksheet, Adresse As String
Set wks1 = ActiveWorkbook.Sheets("Daten")
Set Archiv = ActiveWorkbook.Sheets("Archiv")
Set Suchbereich = wks1.Range("H2:H" & wks1.UsedRange.Row + wks1.UsedRange.Rows.Count - 1)
With Suchbereich
Set Finden = .Find(What:="X", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Finden Is Nothing Then Exit Sub
Adresse = Finden.Address
Do
Set Daten = wks1.Range(wks1.Cells(Finden.Row, "A"), wks1.Cells(Finden.Row, "L"))
Daten.Interior.ColorIndex = 3 ' Farbe = rot
Daten.Copy
zeile = Archiv.UsedRange.Row + Archiv.UsedRange.Rows.Count
Archiv.Cells(zeile, "A").PasteSpecial Paste:=xlValues
Archiv.Cells(zeile, "M").Value = Date
Set Finden = .FindNext(Finden)
Loop While Not Finden Is Nothing And Adresse <> Finden.Address
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub