Serienbrief Teiladressierung

[NurEinWeitererUser]

Hallo zusammen,

folgende Herausforderung versuche ich aktuell vergeblich zu lösen.
Ich möchte einen Serienbrief erstellen mit einer Teiladressierung:

"An alle Haushalte der Musterstraße 1"

Dahinter steht eine Excel-Liste mit Adressen und einer Spalte, in denen die Haushalte genannt sind. Beispiel:

Spalte A; Straße; Musterstraße
Spalte B; Hausnummer; 1
Spalte C; Haushalte; 5

Im Serienbrief sollen folglich 5 Schreiben mit der Adressierung "An Musterstraße 1" generiert werden.

Da ich hierzu keine Lösung finden konnte, nachfolgend zwei Teilfragen:

1. Gibt es eine Möglichkeit, direkt mit dem Excelblatt einen solchen Serienbrief zu erstellen?

2. Falls nicht, gibt es einen Befehl, mit dem ich die Zeilen mit der in Spalte C stehenden Anzahl dublizieren kann? So hätte ich am Ende eine Excel-Liste, welche 5 Zeilen mit "Musterstraße 1" enthält, mit der ich dann einen einfachen Serienbrief generieren kann.

Danke vorab für Antworten und viele Grüße!

[snb]

In VBA:

Code:

Sub M_snb()
  sn = Sheet1.Cells(1).CurrentRegion
   
  For j = 1 To UBound(sn)
    c00 = c00 & Replace(Space(sn(j, 3)), " ", j & " ")
  Next
   
  sp = Application.Index(sn, Application.Transpose(Split(Trim(c00))), Array(1, 2))
   
  Sheet1.Cells(1, 6).Resize(UBound(sp), 2) = sp
End Sub

[NurEinWeitererUser]

In VBA:

Code:

Sub M_snb()
  sn = Sheet1.Cells(1).CurrentRegion
   
  For j = 1 To UBound(sn)
    c00 = c00 & Replace(Space(sn(j, 3)), " ", j & " ")
  Next
   
  sp = Application.Index(sn, Application.Transpose(Split(Trim(c00))), Array(1, 2))
   
  Sheet1.Cells(1, 6).Resize(UBound(sp), 2) = sp
End Sub

Hi, danke für das Feedback!
Habe es trotz der guten Übersetzungshilfe nicht wirklich zum Laufen bekommen.

Dafür habe ich aber offenbar was gefunden, das hilft. Hiermit habe ich die Excel-Liste mit den dublizierten Einträgen generieren können, mit der man nun einfach einen Serienbrief erstellen kann. Spalte A war Adresse und Spalte B die Anzahl.

Code:

Sub ZeilenEinfuegen()
  Dim rngAnzahl As Range
  Dim iZ As Integer
  Application.ScreenUpdating = False
  For Each rngAnzahl In Columns("B").SpecialCells(xlCellTypeConstants)
    If IsNumeric(rngAnzahl.Value) Then
      If rngAnzahl.Value > 1 Then
        For iZ = 1 To rngAnzahl.Value - 1
          rngAnzahl.Offset(1, 0).EntireRow.Insert
        Next iZ
        Range(rngAnzahl.EntireRow, rngAnzahl.Offset(rngAnzahl.Value - 1) _
          .EntireRow).FillDown
        Range(rngAnzahl, rngAnzahl.Offset(rngAnzahl.Value - 1)) = ""
      Else
        rngAnzahl = ""
      End If
    End If
  Next rngAnzahl
  Application.ScreenUpdating = True
End Sub

Danke und viele Grüße.

[snb]

Spalte A war Adresse und Spalte B die Anzahl.

Lese mal bitte deine Frage in #1. brrr.