Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1796to1800
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
Inhaltsverzeichnis

kleines Problem mit Worksheet_Change

kleines Problem mit Worksheet_Change
06.12.2020 10:08:36
Peter
Hallo,
einen schönen guten Morgen.
Ich habe nur ein kleines Problem und möchte euch Bitten zu prüfen, ob es eine andere Möglichkeit gibt, um den nachfolgenden Code zu beschleunigen.
Wenn in der Spalte S eine Zahl eingebeben wird, wird der Code ausgeführt. Dieser Code wird 6 Mal durchlaufen.
Gibt es eine Möglichkeit dies kürzer zu gestalten?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Dim wksGB As Worksheet
Dim Name As String
Dim wksBu2 As Worksheet
Dim wksKI As Worksheet
Dim lngLetzteKIA As Long
Dim raBereichKIA As Range
Dim wksKd As Worksheet
Dim lngLetzteKdA As Long
Dim raBereichKdA As Range
Dim SuWert As Range
Set wb = ThisWorkbook
Set wksGB = wb.Worksheets("Gesamtbuchungen")
Name = wksGB.Range("AC2")
Set wksBu2 = wb.Worksheets(Name)
Set wksKI = wb.Worksheets("Kontoinhaber")
Set wksKd = wb.Worksheets("Kontodaten")
Set SuWert = wksBu2.Range("G5")
'Code in das entsprechende Tabellenblatt!
If Not Intersect(Target, Range("S2:S" & Cells(Rows.Count, "S").End(xlUp).Row)) Is Nothing  _
And Target.Count = 1 Then
If Target > 0 Then
'Anfang - übertragen Anfangs-und Enddatum und Buchungsjahr
Cells(Target.Row, 1) = CDate(wksBu2.Range("L2"))  'funktioniert
Cells(Target.Row, 2) = CDate(wksBu2.Range("L3"))  'funktioniert
Cells(Target.Row, 3) = CDate(wksBu2.Range("L3")) & " - " & CDate(wksBu2.Range("L3")) _
'funktioniert
'Ende - übertragen Anfangs-und Enddatum und Buchungsjahr
'Anfang Übertragen Kontoinhaberdaten
With wksKI
lngLetzteKIA = .Range("A:A").Cells.Find("*", LookIn:=xlValues, searchdirection:= _
xlPrevious).Row
Set raBereichKIA = .Range(.Cells(lngLetzteKIA, 1), .Cells(lngLetzteKIA, 5))
raBereichKIA.Copy
Cells(Target.Row, 4).PasteSpecial xlPasteValues
End With
'Ende Übertragen Kontoinhaberdaten
'Anfang Übertragen Kontodaten
With wksKd
lngLetzteKdA = .Range("F:F").Cells.Find(SuWert, LookIn:=xlValues,  _
searchdirection:=xlPrevious).Row
Set raBereichKdA = .Range(.Cells(lngLetzteKdA, 1), .Cells(lngLetzteKdA, 10))
raBereichKdA.Copy
Cells(Target.Row, 9).PasteSpecial xlPasteValues
End With
'Ende Übertragen Kontodaten
Application.CutCopyMode = False 'kopierten Bereich aufheben
End If
End If
Set SuWert = Nothing
Set wksKd = Nothing
Set wksKI = Nothing
Set wksBu2 = Nothing
Set wksGB = Nothing
Set wb = Nothing
End Sub
Besten Dank
Gruss
Peter

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

Betreff
Datum
Anwender
Anzeige
AW: kleines Problem mit Worksheet_Change
06.12.2020 10:12:51
Hajo_Zi
Hallo Peter,
nach

If Target > 0 thehn
fehlt
Application.EnableEvents = False
vor End if wieder auf True setzen.


AW: kleines Problem erledigt
06.12.2020 11:17:06
Peter
Hallo Hajo,
besten Dank für Deine Hilfe funktionert einwandfrei.
Wünsche Dir noch einen schönen 2. Advent.
Gruss
Peter
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige