ohne deinen Exakten Tabellenaufbau zu kennen habe ich mal etwas geraten. der Code ist ungetestet und dient nur mal zum ansehen. bzgl der Schleifen.
Sub Main()
Dim lrowcnt&, lcolcnt&, cnt&
Dim sDay$, dtDate As Date
Dim doc As Document
Dim bkmrk As Bookmark
Set doc = getWordatei
With Tabelle2
For lrowcnt = 2 To .Cells(Rows.Count, 8).End(xlUp).Row
'zeilenweise (tage)
If .Cells(lrowcnt, 8).Value <> "" Then 'Zelle mit datum
dtDate = .Cells(lrowcnt, 8).Value
If Weekday(dtDate, vbMonday) < 6 Then 'Wochentageingrenzung evtl unötig
sDay = Format(.Cells(lrowcnt, 8).Value, "dddd")
doc.Bookmarks(sDay & "Datum").Range.Text = .Cells(lrowcnt, 8).Value
doc.Bookmarks(sDay & "Temp").Range.Text = .Cells(lrowcnt, 9).Value
doc.Bookmarks(sDay & "Wetter").Range.Text = .Cells(lrowcnt, 10).Value
For lcolcnt = 11 To .Cells(.Columns.Count, 1).End(xlToLeft).Column Step 2
'spaltenweise (Firma)
If .Cells(1, lcolcnt) <> "" Then 'Zelle mit Firma
cnt = cnt + 1 'firmazähler
doc.Bookmarks(sDay & "Firma" & cnt).Range.Text = .Cells(lrowcnt, lcolcnt).Value
doc.Bookmarks(sDay & "Firma" & cnt & "MA").Range.Text = .Cells(lrowcnt + 1, lcolcnt).Value
End If
Next
End If
End If
Next
End With
For Each bkmrk In doc.Bookmarks
If bkmrk.Empty Then bkmrk.Delete
Next
Set doc = Nothing
End Sub
|