Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
424to428
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
424to428
424to428
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Worksheet_Change ... Endlos Schleife...

Worksheet_Change ... Endlos Schleife...
11.05.2004 13:57:32
STeffen
Hallo, folgender Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'Auswahl nach Personal Nummer
If Target.Address = "$C$4" Then
Call Transfer
End If
'Auswahl nach dem Mitarbeiter
If Target.Address = "$C$5" Then
Call Transfer2
End If
End Sub


Private Sub Transfer()
Dim rngAct As Range
Sheets("Personal").Range("A1").CurrentRegion.AutoFilter
Worksheets("Personal").Range("A2").AutoFilter Field:=1, Criteria1:=Range("C4").Value
Set rngAct = Worksheets("Personal").Range("A3").CurrentRegion.SpecialCells(xlCellTypeVisible)
rngAct.Copy Worksheets("Mitarbeiterprofil").Range("A1")
ActiveCell.FormulaR1C1 = "=IF(R[-2]C[-2]="""","""",R[-2]C[-2])"
End Sub


Private Sub Transfer2()
Dim rngAct As Range
Sheets("Personal").Range("A1").CurrentRegion.AutoFilter
Worksheets("Personal").Range("B2").AutoFilter Field:=2, Criteria1:=Range("C5").Value
Set rngAct = Worksheets("Personal").Range("A3").CurrentRegion.SpecialCells(xlCellTypeVisible)
rngAct.Copy Worksheets("Mitarbeiterprofil").Range("A1")
ActiveCell.FormulaR1C1 = "=IF(R[-3]C[-1]="""","""",R[-3]C[-1])"
End Sub

Sobald er in der zeile Active Cell ist fängt er leider wieder von Vorne an :(
kann man die Worksheet Prozedur nicht solange deaktivieren bis man über Sub Transfer drüber ist? :-)
Hoffe ihr versteht mich
Mfg Steffen

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Worksheet_Change ... Endlos Schleife...
Kurt

Private Sub Worksheet_Change(ByVal Target As Range)
application.enableevents = false
on error goto fehler
'Auswahl nach Personal Nummer
If Target.Address = "$C$4" Then
Call Transfer
End If
'Auswahl nach dem Mitarbeiter
If Target.Address = "$C$5" Then
Call Transfer2
End If
fehler:
application.enableevents = true
End Sub

Kurt
AW: Worksheet_Change ... Endlos Schleife...
11.05.2004 14:18:20
Steffen
Besten dank!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige