Sub KopierenDruck()
Dim Anzahl As String
Dim a As Integer
Anzahl = Cells(4, 3).Value
For a = 1 To Anzahl
Sheets("GS-Vorlage").Select
Range("E5").Value = i
Sheets("Tageszeitungen").Select
Range("D4").Select
Selection.Copy
Sheets("GS-Vorlage").Select
Range("F3").Select
ActiveSheet.Paste
Sheets("Tageszeitungen").Select
Range("A4").Select
Selection.Copy
Sheets("GS-Vorlage").Select
Range("F4").Select
ActiveSheet.Paste
Sheets("Tageszeitungen").Select
Range("E4").Select
Selection.Copy
Sheets("GS-Vorlage").Select
Range("F5").Select
ActiveSheet.Paste
Range("F3:F5").Select
With Selection.Font
.Name = "Century Gothic"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.ThemeFont = xlThemeFontMinor
End With
Selection.Font.Italic = False
Selection.Font.Bold = True
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Selection.InsertIndent -1
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Next a
Sheets("Tageszeitungen").Select
End Sub
_________________________________________________________________________
Wie erreiche ich nun, dass dieser Vorgang automatisch auch für die weiteren Zeilen (bis zur ersten leeren Zeile) fortgesetzt wird? Leider kenne ich mich mit Variablen nicht so gut aus.
Was ich an zu übertragenden Daten benötige, wären die Variablen: