Zeilen kopieren

Private Sub CommandButton1_Click() Dim x As Integer, a As Integer, b As Integer Application.ScreenUpdating = False a = Sheets("Eingabe").Range("D7") b = Sheets("Eingabe").Range("F7") Rows("1:31").Copy For x = a To b Step 32 Rows(x).Insert Next x Application.ScreenUpdating = True ActiveWindow.SmallScroll Down:=32 End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zeilen kopieren

27.10.2005 11:23:09

Matthias

AW: Zeilen kopieren

27.10.2005 17:05:18

Andreas

Private Sub CommandButton1_Click() Dim a, b Dim i As Integer a = Sheets("Eingabe").Range("D7") b = Sheets("Eingabe").Range("F7") For i = a To b Kopiere i Next i End Sub Sub Kopiere(Nummer) Dim lz As Long, z_eintrag As Long With Sheets("Lieferaufkleber") lz = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 z_eintrag = lz + 10 .Rows("1:31").Copy Destination:=.Cells(lz, 1) .Cells(z_eintrag, 19) = Nummer End With End Sub

Hallo Matthias,
danke für Dein Script, ich damit jedoch nicht so richtig klar gekommen. Habe mit einem Kollegen in Anlehnung an Deinem Script folgendes geschrieben (Vermutlich viel zu umständlich aber es funktioniert)!


Private Sub CommandButton1_Click()
Dim a, b As Integer
Dim i As Integer
Dim form As Object
Set form = Sheets("Lieferaufkleber").Range("Formular")
Start = Sheets("Eingabe").Range("start")
n_form = form.Rows.Count
a = Sheets("Eingabe").Range("start")
b = Sheets("Eingabe").Range("ende")
If b - a > 50 Then GoTo Info
Sheets("Lieferaufkleber").Select
'Sheets("Lieferaufkleber").Cells(1, 1).Select
Sheets("Lieferaufkleber").Rows("352:18").Select
Selection.Delete Shift:=xlUp
If a < b Then
i = 1
Sheets("Lieferaufkleber").Cells(7, 8).Value = Start
For i = i To (b - a)
Kopiere i
Next i
Sheets("Lieferaufkleber").Cells(1, 1).Select
Application.CutCopyMode = False
Else
MsgBox ("Anfangspositionsnr ist gleich oder kleiner der Endpositionsnr.!")
End If
Exit Sub
Info:
MsgBox ("Mehr als 50 Positionsnr. nicht zulässig!")
End Sub

Sub Kopiere(Nummer)
Dim lz As Long, z_eintrag As Long
Dim form As Object
Set form = Sheets("Lieferaufkleber").Range("Formular")
n_form = form.Rows.Count
Start = Sheets("Eingabe").Range("start")
fl = n_form + 5
Application.ScreenUpdating = False
With Sheets("Lieferaufkleber")

Sheets("Lieferaufkleber").Rows("1:18").Select
Selection.Copy

Sheets("Lieferaufkleber").Cells((Nummer * fl) + 2, 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Lieferaufkleber").Cells((Nummer * fl) + 8, 8).Value = Start + Nummer

End With
Application.ScreenUpdating = True
End Sub
Sub Info()
MsgBox ("Mehr als 50 Positionsnr. nicht zulässig!")
End Sub
Danke nochmal
Gruß Andreas

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen kopieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread