Code zusammenfassen u. ändern

Bild

Betrifft: Code zusammenfassen u. ändern
von: Lorenz Korsalka
Geschrieben am: 16.11.2003 12:24:16

Hallo!!
und Grüsse an alle die trotz Sonntagsruhe um Erfolg bemüht sind!

Wie kann ich (Wer kann mir)die drei Code zusammen ausführen, bzw kürzer schreiben?
Alle drei alleine funktionieren ausgezeichnet! (stammen aus diesem Forum bzw. VBA Beispiele v. HWH)
Allerdings würde ich eine Variante benötigen, wo sich die Formel die kopiert werden soll, jeweils in Zeile 6 befindet.
Alle Drei sollen sich nur im Bereich von Zeile 6 bis incl. Zeile 89 bemerkbar machen.
Hier meine verwendeten Codes:


Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Column <> 140 Then Exit Sub
   Cells(Target.Row - 1, 59).Copy Cells(Target.Row, 59)
   Cells(Target.Row - 1, 60).Copy Cells(Target.Row, 60)
   Cells(Target.Row - 1, 63).Copy Cells(Target.Row, 63)
   Cells(Target.Row - 1, 64).Copy Cells(Target.Row, 64)
   Cells(Target.Row - 1, 67).Copy Cells(Target.Row, 67)
   Cells(Target.Row - 1, 68).Copy Cells(Target.Row, 68)
   Cells(Target.Row - 1, 72).Copy Cells(Target.Row, 72)
   Cells(Target.Row - 1, 73).Copy Cells(Target.Row, 73)
   Cells(Target.Row - 1, 75).Copy Cells(Target.Row, 75)
   Cells(Target.Row - 1, 76).Copy Cells(Target.Row, 76)
   Cells(Target.Row - 1, 79).Copy Cells(Target.Row, 79)
   Cells(Target.Row - 1, 80).Copy Cells(Target.Row, 80)
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Column <> 56 Then Exit Sub
   Cells(Target.Row - 1, 249).Copy Cells(Target.Row, 249)
   Cells(Target.Row - 1, 250).Copy Cells(Target.Row, 250)
   Cells(Target.Row - 1, 251).Copy Cells(Target.Row, 251)
   Cells(Target.Row - 1, 252).Copy Cells(Target.Row, 252)
   Cells(Target.Row - 1, 253).Copy Cells(Target.Row, 253)
   Cells(Target.Row - 1, 254).Copy Cells(Target.Row, 254)
   Cells(Target.Row - 1, 255).Copy Cells(Target.Row, 255)
   Cells(Target.Row - 1, 256).Copy Cells(Target.Row, 256)
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim ZeigBereich As Range
Set ZeigBereich = Range("a6:a89")
If Intersect(Target, ZeigBereich) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Rows(Target.Row).Select
    Target.Activate
    Application.EnableEvents = True
End Sub



Danke im Voraus Lorenz
Bild


Betrifft: AW: Code zusammenfassen u. ändern
von: ChrisL
Geschrieben am: 16.11.2003 13:12:14

Hi Lorenz

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 6 And Target.Row <= 89 Then
   If Target.Column = 140 Then _
   Range(Cells(6, 59), Cells(6, 80)).Copy Cells(Target.Row, 59)
   
   If Target.Column = 56 Then _
   Range(Cells(6, 249), Cells(6, 256)).Copy Cells(Target.Row, 249)
End If
End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Row >= 6 And Target.Row <= 89 And Target.Column = 1 Then _
Rows(Target.Row).Select
End Sub



Gruss
Chris


Bild


Betrifft: AW: Code zusammenfassen u. ändern
von: Lorenz K.
Geschrieben am: 16.11.2003 13:42:19

Hi Chris!
Tausend Dank für die BlitzHilfe!
Hab`s ausprobiert,.... und funktioniert super!!!!!!!!!!!!!!!!!
Da das Angeführte nur ein Auszug meiner Variante ist, wird der neue Code viel kleiner u. übersichtlicher!
Was soll ich noch sagen???????
Super, Super, 1. Sahne, Danke, Danke!!!!!!!!!!!!!!!!!!

:-) Grüsse Lorenz


Bild

Beiträge aus den Excel-Beispielen zum Thema " Code zusammenfassen u. ändern"