Zelle bei mehreren Bedingungen kopieren
Bastian
ich bräuchte mal wieder etwas Hilfe.
ich habe eine ganze Reihe von periodischen Aufträgen, die normalerweise immer einzeln in ein Worddokument getippt wurden und dann an Lieferanten verschickt worden sind.
Entscheidend ist, dass unter einem Stichwort 1 - 3 Bestellpositionen erfasst werden können und unter einem Stichwort verschiedene Lieferanten angesprochen werden können, außerdem können diverse Bestellorte existieren.
Zur Vereinfachung habe ich die Basisdaten in eine Excelliste erfasst und mir ein Worddokument mit Textfeldern erstellt und die beiden Dateien verknüpft.
Ich habe die Routine schon soweit, dass sofern ein Auftrag nur eine Position bei einem Lieferanten hat, dass wunderbar funktioniert. Das Dokument wird automatisch mit allen Daten gefüllt, speichert sich selbstständig unter einem eindeutigen Namen ab und schließt sich wieder und die Routine läuft weiter.
Mein Problem ist folgendes:
Bei 2 Positionen muss ein anderes Dokument angesprochen werden (kein Problem) und die Daten der 2. Bestellposition ebenfalls eingeben werden (Problem).
Wie schafft man es, dass die Routine die komplette Liste durchsucht, ob eine 2. Zeile existiert mit dem selben Lieferantennamen und Bestellstichwort und diese Daten für die 2. Bestellposition übernimmt?
Meinen Code habe ich angehängt und soweit abgespeckt, das nur die Zeilen drin sind, die für diesen Fall relevant sind.
Die wichtigsten Daten stehen in der Excelliste in folgenden Spalten:
Stichwort: 1 (A)
Lieferantenname: 11 (K)
Bestellort: 12 (L)
Summenprodukt aus Stichwort, Lieferantenname, Bestellort: 29 (AC)
Sub test()
Dim appWord As Object
Dim Bestellvorlage As Object
For i = 4 To 5 'Zur Vereinfachung nur diese beiden Zeilen
' 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_2 _
Positionen_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
'Bestellvorlage.Bookmarks("Bogenanzahl2").Range.Text = Cells(?, 10).Value
'Bestellvorlage.Bookmarks("Papier2").Range.Text = Cells(?, 8).Value
'Bestellvorlage.Bookmarks("Grammatur2").Range.Text = Cells(?, 2).Value
'Bestellvorlage.Bookmarks("Format2").Range.Text = Cells(?, 5).Value
'Bestellvorlage.Bookmarks("Laufrichtung2").Range.Text = Cells(?, 6).Value
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
Next i
Set docTest = Nothing
Set appWord = Nothing
End Sub
Ich hoffe ich habe die wichtigsten Daten angegeben, sonst bitte kurz nachfragen.
Hat jemand eine Idee wie man das lösen kann?
Danke und viele Grüße
Bastian
Anzeige