Hallo zusammen,

ich habe folgende Herausforderung:

Wenn im Tabellenblatt „Verkaufsgruppen“ in der Spalte D3:D215 ein „Ja“ vorkommt, soll im Tabellenblatt “Giesserei“  jeweils Ab Zeile4 ; 3 neue Zeilen eingefügt werden.  Die 1. Zeile soll in der Spalte B den Inhalt “ VOK“ bekommen, die  2.  Zeile „BEMI“ und die 3. Zeile “Invest“. In Spalte A sollen die 3 Zeilen verbunden und zentriert werden. Des Weiteren soll in dieser Spalte A jeweils der Name der Verkaufsgruppe, welche im Tabellenblatt “Verkaufsgruppen“ in der Spalte B steht, übernommen werden.

In der Zeile 5;6;7 sollen die Summen der Werte, welche man manuell in die Spalte C der neuen Zeilen einträgt, gebildet werden. Die neuen Zeilen müssen also in eine Summenformel integriert werden.

Bin VBA Neuling und Habe leider nicht die Zeit mir alle Grundkenntnisse anzueignen, da mein Chef das so schnell wie möglich haben möchte. Habe auch nach stundenlangen googlen kein vergleichbares Makro gefunden.  Habe versucht einiges über den Makro-aufzeichner zu lösen aber leider ohne Erfolg, da dies zu statisch ist.

Hier mein Ansatz: (wobei dieser wie gesagt viel zu statisch und ohne kopieren der Bezeichnung sowie das Integrieren in die Summenformel ist)

 Option Explicit    

Option Compare Text

Sub Makro3()

    Const strSearchText = "Ja"              
    Dim rSearch As Range, c As Range
    Dim wsSrc As Worksheet                 
    Set wsSrc = Sheets("Verkaufsgruppen")  
    Set rSearch = wsSrc.Range("D3:D215")    
    For Each c In rSearch                   
    If c.Value = strSearchText Then
 
    Sheets("Giesserei").Select
    Rows("4:4").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Range("B5").Select
    ActiveCell.FormulaR1C1 = "VOK"
    Range("B6").Select
    ActiveCell.FormulaR1C1 = "BEMI"
    Range("B7").Select
    ActiveCell.FormulaR1C1 = "Invest"
   
    Range("A5:A7").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
   
    End If
    Next c
    End Sub

Ich hoffe ihr könnt mir helfen (wenn das überhaupt machbar ist -.-)

Mit freundlichen Grüßen

peyd