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
|