Textbausteine bedarfsweise nacheinander einfügen

Ein Bekannter hatte eine Tabelle mit Berechnungen, die am Ende der Berechnung aus einer Auswahl von Textbausteinen individuell wählbare Textbausteine eingefügt bekommen soll.

Die Startzeile (in meinem Beispiel Zeile 9) war definiert. Da die Textbausteine unterschiedliche Längen haben und nach jedem gewählten Textbaustein eine Leerzeile kommen soll, muss der Code individuell zunächst prüfen, welche Textbausteine gewählt sind, wie lang diese sind und an welcher Zeile diese einzufügen sind.

Um dies zu realisieren nutze ich nachstehenden Code von Alois Eckl, der durch einen Commandbutton ausgelöst wird. Sub bausteine() '** Dimensionierung Dim lngZeile As Long Dim a As Long '** Vorgaben definieren Set wsb = ThisWorkbook.Sheets("Bausteine") Set wsa = ThisWorkbook.Sheets("Ausdruck") lngZeile = 9 'Startzeile definieren '** Ausgabebereich löschen wsa.range("B9:E100").ClearContents '** Prüfen, wo x gesetzt ist - Durchlaufen der Zeile 2 For a = 1 To 4 If LCase(wsa.Cells(2, a + 1).Value) = LCase("x") Then '** Übertragen der Bausteine in Spalte B, wenn x gesetzt ist For b = 2 To wsb.Cells(Rows.Count, a).End(xlUp).Row wsa.Cells(lngZeile, 2).Value = wsb.Cells(b, a).Value lngZeile = lngZeile + 1 'Zeile erhöhen Next b '** Leerzeile einfügen lngZeile = lngZeile + 1 End If Next a End Sub

Nach Durchlauf des Code, werden die gewählten Bausteine getrennt durch Leerzeilen eingefügt.

Um die Demodatei herunter zu laden bitte auf nachstehendes Symbol klicken.

 Share on Facebook

Read more http://vba-codeschnipsel.de/textbausteine-bedarfsweise-nacheinander-einfugen/