Durchlaufende numerierung beim kopieren bereich
10.09.2008 20:31:33
Karel
habe letzte mal mit hilfe von euch ein bestimmtes bereich x mal Kopieren in anderes Tabelleblatt Etikett_print gemacht.
zusatz frage:
wie kan man noch eine durchlaufenden nummerierung machen beim Kopieren in Tabelleblat Etikett_print
anzahl durch eingabe in G3 festgelegt
Sehe Etikett_print bereich 1 -8 durchlaufend nummeriert
Option Explicit
Sub test()
Dim rngVor As Range, lngZ As Long, lngS As Long, rngR As Range, ii As Long
Application.ScreenUpdating = False
With Sheets("Eingabe_Etikett")
Set rngVor = .Range("A1:E6")
lngS = rngVor.Columns.Count
lngZ = rngVor.Rows.Count * .Range("G3").Value
End With
With Sheets("Etikett_print").Range("A1").Resize(lngZ, lngS)
.EntireColumn.Clear ' löschen
rngVor.Copy ' kopieren
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteColumnWidths
Application.CutCopyMode = False
For lngZ = 1 To rngVor.Rows.Count ' Zeilenhöhen
Set rngR = .Rows(lngZ)
For ii = 1 To Sheets("Eingabe_Etikett").Range("G3").Value - 1
Set rngR = Union(rngR, .Rows(lngZ + ii * rngVor.Rows.Count))
Next ii
rngR.RowHeight = rngVor.Rows(lngZ).RowHeight
Next lngZ
End With
Worksheets("Etikett_print").PrintOut Copies:=1, Collate:=True
Worksheets("Eingabe_Etikett").Range("G3").Value = 1
Application.ScreenUpdating = True
End Sub
Datei als beispiel dabei
https://www.herber.de/bbs/user/55305.xls
Grüsse
Karel