Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 21:55:37
Preiserhöhung über mehrere Jahre berechnen
17.04.2024 20:19:32
Endzeitpunkt berechnen aus d:hh:mm errechnen
17.04.2024 18:57:33
Errinnerungsfunktion
17.04.2024 16:56:58
Stunden addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
800to804
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
800to804
800to804
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

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
Anzeige
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

Anzeige
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

Anzeige
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

Anzeige
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

Anzeige
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)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige