Makro zum kopieren

Forumthread: Makro zum kopieren

Makro zum kopieren

16.09.2006 16:21:33

WalterK

Hallo
Kann folgendes auch mit einem Makro erledigt werden:
Bei jedem Klick auf die "Formular-Schaltfläche: Zeile 20mal kopieren" soll die Zeile mit dem letzten Eintrag in Spalte M mit allen Formatierungen (auch bedingte) und Formeln 20mal weiter nach unten kopiert werden und das ohne den Blattschutz (kein Kennwort) aufzuheben.
Servus, Walter

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro zum kopieren

16.09.2006 16:31:22

Josef
AW: Makro zum kopieren

16.09.2006 16:41:23

WalterK
AW: Makro zum kopieren

16.09.2006 16:54:45

Josef
AW: Makro zum kopieren

16.09.2006 17:08:08

WalterK
AW: Makro zum kopieren

16.09.2006 21:13:21

Josef
AW: Makro zum kopieren

16.09.2006 21:31:55

WalterK
AW: Makro zum kopieren

16.09.2006 23:06:14

Josef
AW: Makro zum kopieren

16.09.2006 23:17:05

WalterK

AW: Makro zum kopieren

16.09.2006 16:31:22

Josef

Hallo Walter!

Sub Copy20()
Dim rng As Range

Set rng = ActiveSheet.Cells(Rows.Count, 13).End(xlUp).EntireRow

rng.Copy
Rows(rng.Row + 1 & ":" & rng.Row + 20).Insert
Application.CutCopyMode = False

Set rng = Nothing

End Sub

Gruß Sepp

AW: Makro zum kopieren

16.09.2006 16:41:23

WalterK

Hallo Sepp
Das Kopieren funktioniert soweit, allerdings nur, wenn ich vorher den Blattschutz aufhebe.
Geht das auch mit aktiviertem Blattschutz?
Servus, Walter

AW: Makro zum kopieren

16.09.2006 16:54:45

Josef

Hallo Walter!
daruaf hatte ich vergessen! ;-))

Sub Copy20()
Dim rng As Range

With ActiveSheet

  .Protect UserInterFaceOnly:=True

  Set rng = .Cells(Rows.Count, 13).End(xlUp).EntireRow

  rng.Copy
  .Rows(rng.Row + 1 & ":" & rng.Row + 20).Insert
  Application.CutCopyMode = False

  Set rng = Nothing

End With

End Sub

Gruß Sepp

AW: Makro zum kopieren

16.09.2006 17:08:08

WalterK

Hallo Sepp
Das klappt ja wunderbar, perfekt!
Eine letzte Frage hätte ich noch:
In einem anderen Blatt gebe ich in der Zelle K2 vor bis zu welcher Zeilenzahl (z.B. 200) kopiert werden soll. Wie müsste das Makro dann geändert werden?
Vielen Dank jedenfalls, das hat mir sehr weitergeholfen.
Servus, Walter

AW: Makro zum kopieren

16.09.2006 21:13:21

Josef

Hallo Walter!
das geht so.

Sub Copy20()
Dim rng As Range
Dim varC As Variant

varC = Sheets("Tabelle").Range("K2").Value 'Tabellenname anpassen!

If Not IsNumeric(varC) Then varC = 1

With ActiveSheet

  .Protect UserInterFaceOnly:=True

  Set rng = .Cells(Rows.Count, 13).End(xlUp).EntireRow

  rng.Copy
  .Rows(rng.Row + 1 & ":" & rng.Row + varC).Insert
  Application.CutCopyMode = False

  Set rng = Nothing

End With

End Sub

Gruß Sepp

AW: Makro zum kopieren

16.09.2006 21:31:55

WalterK

Hallo Sepp
Jetzt haben wir uns missverstanden. Gemeint war, dass die Zahl in K2 angibt, bis zu welcher Zeilennummer kopiert werden soll. Beispiel: in K2 steht 100, dann kopiere von Zeile 20 (letzter Eintrag in Spalte M) bis Zeile 100
Kannst Du mir nochmal helfen.
Servus, Walter

AW: Makro zum kopieren

16.09.2006 23:06:14

Josef

Hallo Walter!
Dann so.

Sub Copy20()
Dim rng As Range
Dim varC As Variant

varC = Sheets("Tabelle2").Range("K2").Value 'Tabellenname anpassen!

If Not IsNumeric(varC) Then varC = 1

With ActiveSheet

  .Protect UserInterFaceOnly:=True

  Set rng = .Cells(Rows.Count, 13).End(xlUp).EntireRow

  varC = varC - rng.Row
  If varC < 1 Then varC = 1

  rng.Copy
  .Rows(rng.Row + 1 & ":" & rng.Row + varC).Insert
  Application.CutCopyMode = False

  Set rng = Nothing

End With

End Sub

Gruß Sepp

AW: Makro zum kopieren

16.09.2006 23:17:05

WalterK

Hallo Sepp,
Klasse, genauso wollte ich es haben.
Danke für Deine Geduld und Hilfe.
Servus und noch schönes Wochenende, Walter

Beliebteste Forumthreads (12 Monate)

Forumthread: Makro zum kopieren

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread