Code für Leerzeilt

Guten Morgen Zusammen
Ich habe eine Stückliste die ich mit einen netten Tool erweitern möchte.
Leider reichen meine VBA Kenntnisse nicht aus.
Das Makro entfernt den Blattschutz und fügt eine Zeile ein. (Das habe ich noch erstellen können. Anschliessend sollen weitere Schritte gemacht werden;
1. Bei aktiver Zeile bei Spalte A(1) die obere Zelle Kopieren und unten einfügen.
(unabhängig in welcher Spalte Cursor steht
2. Bei aktiver Zeile bei Spalte B(1) dito oben
3. Bei aktiver Zeile bei Spalte V(22) Text "L" ergänzen. Schriftfarbe weiss
4. Bei aktiver Zeile bei Spalte V(23) dito oben
5. Cursor zur alten Position zurückkehren (Ist nur ein Supplement)
Wäre sehr nett, wenn ich da eure wertvolle Hilfe bekomme
Ich werde tausend Mal an euch denken
Chregu
https://www.herber.de/bbs/user/93204.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Schaltfläche48_Klicken() Dim Zeile As Long Dim Zelle As Range ActiveSheet.Unprotect Zeile = ActiveCell.Row Set Zelle = ActiveCell ActiveCell.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove Cells(Zeile - 1, 1).Copy Cells(Zeile, 1) Cells(Zeile - 1, 2).Copy Cells(Zeile, 2) With Cells(Zeile, 22) .Value = "L" .Font.Color = RGB(255, 255, 255) 'weiß End With With Cells(Zeile, 23) .Value = "L" .Font.Color = RGB(255, 255, 255) 'weiß End With ' Befehl wie im Mail beschrieben Zelle.Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub

Hallo Franz
Perfekt. Genau so habe ich mir das Vorgestellt. Habe noch die weisse Schrift in Spalte A+B ergänzt:
Schreibst du das auswendig oder über Vorgefertigte Textblöcke.
Wie lang muss man sich da "reindenken" bis man bis Basis beherrscht
Habe weiss ergänzt: Funktioniert TOP

Sub Schaltfläche48_Klicken()
Dim Zeile As Long
Dim Zelle As Range
ActiveSheet.Unprotect
Zeile = ActiveCell.Row
Set Zelle = ActiveCell
ActiveCell.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Cells(Zeile - 1, 1).Copy Cells(Zeile, 1)
Cells(Zeile - 1, 2).Copy Cells(Zeile, 2)
With Cells(Zeile, 1)
.Font.Color = RGB(255, 255, 255) 'weiß
End With
With Cells(Zeile, 2)
.Font.Color = RGB(255, 255, 255) 'weiß
End With
With Cells(Zeile, 22)
.Value = "L"
.Font.Color = RGB(255, 255, 255) 'weiß
End With
With Cells(Zeile, 23)
.Value = "L"
.Font.Color = RGB(255, 255, 255) 'weiß
End With
Zelle.Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread