Mehrere Sub ausführen

[BastiFantasti84]

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

[Klaus-Dieter]

Hallo,

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

[snb]

Und reduzieren bis

PHP-Code:

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