Modul über ganze Arbeitsmappe

23/09/2009 - 20:16 von Heinz ROGHB346 | Report spam

Option Explicit
Option Compare Text



Private Sub Worksheet_Change(ByVal Target As Range)

Dim R As Range, ColumnC As Range
Dim Y As Long '!!AK-29.08.09
'Was Spalte A geàndert?
If Intersect(Target, Columns(1)) Is Nothing Then GoTo minmax
'Alle Verànderungen in Spalte A prüfen
For Each R In Intersect(Target, Columns(1))
'Ist es ein X?
If R = "x" Then
With Sheets("Einkauf")
'Letzte Zeile in Tabelle2!Spalte A suchen
Y = .Cells(Rows.Count, 1).End(xlUp).Row
'Wenn nicht leer, dann nàchste Zeile
If Not IsEmpty(.Cells(Y, 1)) Then Y = Y + 1
'Zeile kopieren
Rows(R.Row).Copy .Cells(Y, 1)
End With
End If
Next
minmax:
'Geànderte Zellen in Spalte C ermitteln
Set ColumnC = Intersect(Target, Columns("C"))
'Welche da?
If ColumnC Is Nothing Then Exit Sub
'Jede Zelle einzeln durchlaufen
For Each R In ColumnC
Application.EnableEvents = False
If R < Range("D" & R.Row) Then
Range("D" & R.Row) = R
Range("H" & R.Row) = Now() '!!AK-29.08.09
ElseIf R > Range("D" & R.Row) Then
If R > Range("E" & R.Row) Then
Range("E" & R.Row) = R
Range("H" & R.Row) = Now() '!!AK-29.08.09
End If '!!AK-29.08.09
Else
'C4 = D4
End If
Application.EnableEvents = True
Next
End Sub




Hallo,

wie oder was muß ich àndern das dieses Modul in der ganzen Arbeitsmappe
ablàuft.


MŽfGruß Heinz
 

Lesen sie die antworten

#1 Martin Worm
23/09/2009 - 23:12 | Warnen spam
Am Wed, 23 Sep 2009 20:16:29 +0200,schrieb Heinz ROGHB346:

hallo,

Private Sub Worksheet_Change(ByVal Target As Range)



im Modul DieseArbeitsmappe gibt es das Ereignis
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range).

With Sheets("Einkauf")





bei dem Block solltest du mit
Application.EnableEvents = False
die Ereignisse ausklammern.
ich sehe aber, du weißt, wie es geht

mit freundlichen Grüßen

Martin Worm
benutze XL 2000 und Win XP SpX

Ähnliche fragen