Clever-Excel-Forum

Normale Version: Mehrere Sub ausführen
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Hallo,

ich bin absoluter VBA Amateur

Ich möchte folgende Sub ausführen, leider funktioniert der zweite Teil, sprich das Kopieren in Spalte AR nicht :(  In Spalte AP wird alles kopiert.
Hier der komplette Code:


Code:
Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Address
    Case "$D$16"
        Me.Range("AO1") = 1
    Case "$F$16"
        Me.Range("AO1") = 2
    Case "$H$16"
        Me.Range("AO1") = 3
    Case "$J$16"
        Me.Range("AO1") = 4
    Case "$L$16"
        Me.Range("AO1") = 5
    Case "$D$18"
        Me.Range("AO1") = 6
    Case "$F$18"
        Me.Range("AO1") = 7
    Case "$H$18"
        Me.Range("AO1") = 8
    Case "$J$18"
        Me.Range("AO1") = 9
    Case "$L$18"
        Me.Range("AO1") = 10
    Case "$D$20"
        Me.Range("AO1") = 11
    Case "$F$20"
        Me.Range("AO1") = 12
    Case "$H$20"
        Me.Range("AO1") = 13
    Case "$J$20"
        Me.Range("AO1") = 14
    Case "$L$20"
        Me.Range("AO1") = 15
                   
End Select
End Sub

Sub Worksheet_SelectionChange_2(ByVal Target As Range)
Select Case Target.Address_2
    Case "$X$16"
        Me.Range_2("AQ1") = 1
    Case "$Z$16"
        Me.Range_2("AQ1") = 2
    Case "$AB$16"
        Me.Range_2("AQ1") = 3
    Case "$AD$16"
        Me.Range_2("AQ1") = 4
    Case "$AF$16"
        Me.Range_2("AQ1") = 5
    Case "$X$18"
        Me.Range_2("AQ1") = 6
    Case "$Z$18"
        Me.Range_2("AQ1") = 7
    Case "$AB$18"
        Me.Range_2("AQ1") = 8
    Case "$AD$18"
        Me.Range_2("AQ1") = 9
    Case "$AF$18"
        Me.Range_2("AQ1") = 10
    Case "$X$20"
        Me.Range_2("AQ1") = 11
    Case "$Z$20"
        Me.Range_2("AQ1") = 12
    Case "$AB$20"
        Me.Range_2("AQ1") = 13
    Case "$AD$20"
        Me.Range_2("AQ1") = 14
    Case "$AF$20"
        Me.Range_2("AQ1") = 15
           
End Select
End Sub

Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) <> "AO1" Then Exit Sub
  Range("AP1").Insert Shift:=xlDown
  Range("AP1").Value = Target.Value
  Range("AP9999").ClearContents
End Sub

Sub Worksheet_Change_2(ByVal Target As Range)
If Target.Address_2(0, 0) <> "AQ1" Then Exit Sub
  Range("AR1").Insert Shift:=xlDown
  Range("AR1").Value = Target.Value
  Range("AR9999").ClearContents
End Sub
Hallo,

du musst das zusammen fassen, pro Tabellenblatt funktioniert SelctionCange und Change nur einmal.
Und reduzieren bis


PHP-Code:
Sub Worksheet_SelectionChange(ByVal Target As Range)
    Range("AO1") = ((target.Column 4) \ 2) + * (target.Row 16) + 1
End Sub