AW: Ich denke hier ist eine Musterdatei..
28.09.2018 13:02:46
UweD
Hallo
hab mal was gebastelt.
Kombination aus Formeln und VBA
Modul1
Option Explicit
Sub GS_drucken()
Dim Z1 As Integer, LR As Integer, TB1, TB2, Anzahl As Integer
Dim i As Integer, j As Integer, k As Integer
Dim RNG As Range, WF, LastRech As Long, Abstand As Integer
Set TB1 = Sheets("Start")
Set TB2 = Sheets("Template")
Set WF = WorksheetFunction
Set RNG = TB1.Range("B5:C7") ' Währungen
Z1 = 12 'Empfänger ab Zeile..
Anzahl = 8 ' anzahl GS auf einem Blatt
Abstand = 11 'Abstand s der Gutscheine
With TB1
LR = .Cells(.Rows.Count, "B").End(xlUp).Row 'letzte Zeile der Spalte
For i = Z1 To LR Step Anzahl ' immer 8 Zeilen abarbeiten
k = 0
For j = 0 To Anzahl - 1 Step 2 'immer 2 Spalten füllen
With .Cells(i + j, 2)
If .Value <> "" Then
TB2.Cells(4 + k, 5) = .Value
TB2.Cells(4 + k, 6) = WF.VLookup(.Offset(0, 1), RNG, 2, 0) _
& " " & .Offset(0, 1)
Else
TB2.Cells(4 + k, 5).ClearContents
TB2.Cells(4 + k, 6).ClearContents
End If
End With
With .Cells(i + 1 + j, 2)
If .Value <> "" Then
TB2.Cells(4 + k, 14) = .Value
TB2.Cells(4 + k, 15) = WF.VLookup(.Offset(0, 1), RNG, 2, 0) _
& " " & .Offset(0, 1)
Else
TB2.Cells(4 + k, 14).ClearContents
TB2.Cells(4 + k, 15).ClearContents
End If
End With
k = k + Abstand ' Im Gutschein die nächte Reihe wählen
Next j
'ausdrucken
TB2.PrintOut Copies:=1
'Rechnungsnummer updaten
.Range("F8") = .Range("F9")
Next
End With
End Sub
https://www.herber.de/bbs/user/124277.xlsm
LG UweD