Zelle mehrere Bedingungen kopieren funktioniert

Hallo Bastian,
du muss nach dem Übertragen des 1. Satzes Daten eine Suchschleife einbauen für den 2. Satz.
Zusätzlich muss du einen Merker einführen, für die schon nach Word übertragenen Positionen.  _
Diese müssen übersprungen werden, wenn der Zähler i auf diese Positionen trifft.
Ich hab hierfür das Datenfeld bolNachWord eingerichtet.
Nachfolgend deine Prozedur (ungetestet) entsprechend angepasst. Bei Versand von 3 Positionen  _
muss du einen weiteren ähnlichen Block einfügen. Der For-Next-Zähler muss dann bei j+1  _
weitermachen.
Gruß
Franz
Sub test()
Dim appWord As Object
Dim Bestellvorlage As Object, bolNachWord() As Boolean
Dim i As Long, j As Long, ZeileLetzte As Long
Dim Bestellvorlagespeichern As String
ZeileLetzte = 10
ReDim bolNachWord(4 To ZeileLetzte) ' oberer Wert identisch mit For-Next-Schleifen-Zähler
For i = 4 To ZeileLetzte 'Zur Vereinfachung nur diese beiden Zeilen
If bolNachWord(i) = False Then
' In Spalte 29 ist das Summenprodukt aus Stichwort, Lieferantenname und Bestellort - hier    _
_
_
gibt _
es also unter einem Stichwort, einen Lieferanten der an einen Standort liefert mit 2  _
Positionen
If Cells(i, 29) = 2 And Cells(i, 7) = "Bogen" Then
' Richtige Bestellvorlage öffnen
Set appWord = CreateObject("Word.Application")
Set Bestellvorlage = _
appWord.Documents.Open("P:\Periodika 2011\Vorlagen\Jahresplanung_Bogen_2Positionen_Test")
appWord.Visible = True
'Bestellvorlage mit Daten der Excelliste befüllen - die mit " ' "gekennzeichneten sind die   _
_
_
_
Felder für die 2. Bestellposition die Probleme bereiten.
' Die korrekte Spalte ist bereits angegeben, die Zeile ist mit einem "?" versehen.
Bestellvorlage.Bookmarks("Lieferantenname").Range.Text = Cells(i, 19).Value
Bestellvorlage.Bookmarks("Bogenanzahl1").Range.Text = Cells(i, 10).Value
Bestellvorlage.Bookmarks("Papier1").Range.Text = Cells(i, 8).Value
Bestellvorlage.Bookmarks("Grammatur1").Range.Text = Cells(i, 2).Value
Bestellvorlage.Bookmarks("Format1").Range.Text = Cells(i, 5).Value
Bestellvorlage.Bookmarks("Laufrichtung1").Range.Text = Cells(i, 6).Value
bolNachWord(i) = True
'Zeile mit 2. Eintrag suchen
'Stichwort: 1 (A)
'Lieferantenname: 11 (K)
'Bestellort: 12 (L)
'Summenprodukt aus Stichwort, Lieferantenname, Bestellort: 29 (AC)
For j = i + 1 To ZeileLetzte
If Cells(j, 1) = Cells(i, 1) And Cells(j, 11) = Cells(i, 11) _
And Cells(j, 12) = Cells(i, 12) Then
Bestellvorlage.Bookmarks("Bogenanzahl2").Range.Text = Cells(j, 10).Value
Bestellvorlage.Bookmarks("Papier2").Range.Text = Cells(j, 8).Value
Bestellvorlage.Bookmarks("Grammatur2").Range.Text = Cells(j, 2).Value
Bestellvorlage.Bookmarks("Format2").Range.Text = Cells(j, 5).Value
Bestellvorlage.Bookmarks("Laufrichtung2").Range.Text = Cells(j, 6).Value
bolNachWord(j) = True
Exit For
End If
Next j
Bestellvorlage.Bookmarks("Datum1").Range.Text = Cells(i, 33).Value
'Speichern der Bestellvorlage unter Zellbezügen
Bestellvorlagespeichern = "P:\Periodika 2011\Bestellungen Periodika 2011\Jahresplanung  _
2011_" & _
Workbooks("Bogenberechnung Test").Sheets("Periodika 2011").Cells(i, 12).Value & "_" & _
Workbooks("Bogenberechnung Test").Sheets("Periodika 2011").Cells(i, 11).Value & "_" _
& Workbooks("Bogenberechnung Test").Sheets("Periodika 2011").Cells(i, 1).Value & ".doc"
Bestellvorlage.SaveAs Filename:=Bestellvorlagespeichern
appWord.Documents.Close
appWord.Quit
End If
End If
Next i
Set Bestellvorlage = Nothing
Set appWord = Nothing
End Sub