Zeilen kopieren

Hallo Zusammen,
Ich habe ein Excel Tabelle, in der von links nach rechts bestimmte Felder in der Zeile (zB. Zeile 11) befüllt werden soll. Andere Felder in der Zeile 11 sind gesperrt.
Ich möchte das der Nutzer frei Feld (zB G11) für Feld (zB H11) welche nicht gesperrt sind füllt. In der Excel Datei soll es dann ein Button geben , mit dem eine neue Zeile (in diesem Fall 12) eingefügt wird. Alle Formeln + die Daten aus den gesperten Feldern aus Zeile 11 sollen nach 12 kopiert werden (Formel natürlich entsprechend auf Zeile angepasst).
Natürlich soll eine Überprüfung stattfinden, ob das kopieren geht, sprich ob in G12 schon was steht oder nicht. Wenn in G12 was steht soll die Zeile von G12 in G13 gefüllt werden.
Das Kopieren bekomme ich sicher über Makro aufzeichnen hin aber leider nicht die Überprüfung ob in der Zeile schon was steht :-)
Die Autoaufzeichnung ergibt diesen Quellcode:


Sub Makro1()
Rows("11:11").Select
Selection.AutoFill Destination:=Rows("11:12"), Type:=xlFillDefault
Rows("11:12").Select
End Sub

Kann mir jemand Helfen, dass Marko entsprechnend umzusetzen? Viele Dank.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Dan,
hier mal 2 Varianten.
Variante 1 fügt an der aktuell selektierten Zelle eine Zeile ein/an
Variante 2 fügt eine Zeile am Ende der Liste an.
Ob der Blattschutz ein-/ausgeschaltet werden muss hängt von eingestellten Optionen ab.
Gruß
Franz


Sub ZeileEinfuegen()
Dim lZeile As Long, wks As Worksheet
Set wks = ActiveSheet
lZeile = ActiveCell.Row
If lZeile > 5 Then
With wks
'Blattschutz deaktivieren
.Unprotect
'Prüfen ob Spalte G leer ist
If IsEmpty(.Cells(lZeile, 7)) Then
.Rows(lZeile - 1).AutoFill Destination:=.Range(.Rows(lZeile - 1), .Rows(lZeile)), _
Type:=xlFillDefault
Else
.Rows(lZeile).Insert shift:=xlShiftDown
.Rows(lZeile - 1).AutoFill Destination:=.Range(.Rows(lZeile - 1), .Rows(lZeile)), _
Type:=xlFillDefault
End If
'Inhalte in den auszufüllenden Zellen löschen
.Cells(lZeile, 7).ClearContents
.Cells(lZeile, 8).ClearContents
'Blattschutz aktivieren
.Protect
End With
Else
MsgBox "Oberhalb von Zeile 5 dürfen keine Zeilen eingefügt werden!"
End If
End Sub
Sub ZeileAnfuegen()
Dim lZeile As Long, wks As Worksheet
Set wks = ActiveSheet
With wks
lZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'hier ggf. andere spalte wählen!
'Blattschutz deaktivieren
.Unprotect
.Rows(lZeile - 1).AutoFill Destination:=.Range(.Rows(lZeile - 1), .Rows(lZeile)), _
Type:=xlFillDefault
'Inhalte in den auszufüllenden Zellen löschen
.Cells(lZeile, 7).ClearContents
.Cells(lZeile, 8).ClearContents
'Blattschutz aktivieren
.Protect
End With
End Sub

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread