Zeile per VBA einfügen
Michael Karajan
Ich habe in Foren irgendwie für mein Problem nicht das richtige gefunden.
Vielleicht habe ich auch nicht das richtige zum suchen eingegeben.
Ich habe eine Tabellemit ca. 2000 Zeilen (Excel 2003).
Ich habe ein Userform erstellt und stehe nun vor dem Problem, dass ich die
Daten iaus dem Userforum in Tabelle übertrage. Nicht irgendwo sondern an
einem speziellen Platz. Jetzt kommt der Haken, für die ich keine Lösung fand.
Unterhalb der Tabelle mit Datenzeilen sind Zeilen, die nicht verändert
werden dürfen. Ich muß schaffen (per VBA),
* die letzte Zeile mit den Daten finden
* Eine Zeile zwischen denen die nicht verändert werden dürfen eine Zeile
Einfügen (Es sind 3 Zeilen zwischen Daten und den Zeilen die nicht verändert
werden dürfen)
*und in diese Zeile dann die Eingaben aus dem UserForm eintragen.
Für Eure Ratschläge bin ich wie immer sehr dankbar (schon im Voraus!)
Gruß
Michael
Andreas Killer
> Unterhalb der Tabelle mit Datenzeilen sind Zeilen, die nicht verändert
> werden dürfen. Ich muß schaffen (per VBA),
Hmm, klingt ein wenig kurios, wie willst Du Zeilen einfügen zwischen
Zeilen die nicht verändert werden dürfen???
> * die letzte Zeile mit den Daten finden
Eigentlich sucht man ja von unten, aber in Deinem Fall ist es
vielleicht einfacher von oben zu suchen, was aber voraussetzt das
keine Lücken zwischen den Daten und mind. 2 Zeilen vorhanden sind.
dim R as Range
set R = Range("A1").End(xlDown)
R ist nun die letzte "Daten-"Zelle in Spalte. Man kann auch von unten
suchen:
dim R as Range
'Letzte Zelle in Spalte A
set R = Range("A" & Rows.Count).End(xlUp)
'Erste Zeile der 3 nicht änderbaren Zeilen
set R = R.End(xlUp)
'Letzte "Daten-"Zelle
set R = R.End(xlUp)
Setzt aber voraus das die Daten immer in der Form bleiben wie Du sie
beschrieben hast.
> * Eine Zeile zwischen denen die nicht verändert werden dürfen eine Zeile
> Einfügen (Es sind 3 Zeilen zwischen Daten und den Zeilen die nicht verändert
> werden dürfen)
Also egal wie Du es machst, nach obigen Beispiel ist R nun auf der
letzten Daten-Zelle. Davon ausgehend:
'Eins weiter runter, die Zeile ist leer
set R = R.Offset(1, 0)
'Zeile einfügen, R wird auch eins weitergesetzt
R.Insert Shift:=xlDown
'Wieder eins zurück um am Datenende zu bleiben
Set R = R.Offset(-1, 0)
> *und in diese Zeile dann die Eingaben aus dem UserForm eintragen.
Könnte man dann z.B. so machen:
Cells(R.Row,1) = TextBox1.Value
'oder
Range("A" & R.Row) = TextBox1.Value
usw.
Andreas.
Michael Karajan
Private Sub CommandButton1_Click()
Dim letzteZeile As Integer
Dim dblZeile As Double
Selection.End(xlDown).Select
dblZeile = ActiveCell.Row
Selection.EntireRow.Copy
Cells(dblZeile + 1, 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
'letzte Zeile bestimmen
Range("A65536").End(xlUp).Select
'und eins draufaddieren damit man die erste freie Zeile bekommt
letzteZeile = ActiveCell.Row + 1
'Werte schreiben
ThisWorkbook.Sheets("OE_0230007").Cells(letzteZeile, 1) = Kunde.Value
ThisWorkbook.Sheets("OE_0230007").Cells(letzteZeile, 2) = Txt_Kto_Nr.Value
ThisWorkbook.Sheets("OE_0230007").Cells(letzteZeile, 3) = Txt_PersNr.Value
ThisWorkbook.Sheets("OE_0230007").Cells(letzteZeile, 4) = Txt_Kto_Nr.Value
ThisWorkbook.Sheets("OE_0230007").Cells(letzteZeile, 5) = TxtVorname.Value
ThisWorkbook.Sheets("OE_0230007").Cells(letzteZeile, 7) = TxtNachname.Value
ThisWorkbook.Sheets("OE_0230007").Cells(letzteZeile, 9) = TxtGebDat.Value
ThisWorkbook.Sheets("OE_0230007").Cells(letzteZeile, 12) = Werbe.Value
ThisWorkbook.Sheets("OE_0230007").Cells(letzteZeile, 14) = Txt_TelVor.Value
ThisWorkbook.Sheets("OE_0230007").Cells(letzteZeile, 15) = Txt_TelNr.Value
'und Maske schließen
UserForm1.Hide
End Sub
Gruß Michael
Michael Karajan
Vielen Dank für Deine Antwort. Ich habe Deinen Code ausprobiert. Jedoch
erhalte ich in folgender Zeile einen Fehler:
'Zeile einfügen, R wird auch eins weitergesetzt
R.Insert Shift:=xlDown
Vielleicht hilft das bei der Lösungs-Findung:
Die Tabelle ist geschützt. Ich habe im Code des UserForm's folgenden Code:
Private Sub CommandButton1_Click()
Dim letzteZeile As Integer
Dim R As Range
ActiveSheet.Unprotect
Nach Ausführung des Codes wird die Tabelle wieder geschützt:
ActiveSheet.Protect AllowFiltering:=True
Am Ende der Tabelle (=nicht zu verändernde Zeilen) steht die LEgende. Die
Zeilen in der Tabelle werden,je nach Übereinstimmung der Eingabewerte in
verschiedenen Spalten, Hintergrund Farbig gemacht. Die Legende geht in Spalte
B, 3 Zeilen unterhalb der letzten Zeile mit Werten, los. dieser Abstand soll
immer gewahrt werden.
Das ist der Grund warum ich nachder letzten Zeile mit - "echten" - Werten
eine Zeile einfügen möchte.
Alternativ kann auch ganz oben die Zeile eingefügt werden. In der ersten
Zeile (ab A1) stehen die Spalten überschriften. Deshalb geht es in Zeile 2
los.
Noch einen Hinweis: Das "Fenster" ist Fixiert. Spalten-Überschriften bleiben
und nach rechts etwa in der Mitte der Tabelle werden die Spalten nach links
verschoben. Weiterhin ist in ein 'AutoFilter' "eingeschalten'.
Ich hoffe das ich bald eine Lösung finden kann.
Gruß
Michael
Andreas Killer
<MichaelKara...@discussions.microsoft.com> wrote:
> Vielen Dank für Deine Antwort. Ich habe Deinen Code ausprobiert. Jedoch
> erhalte ich in folgender Zeile einen Fehler:
>
> 'Zeile einfügen, R wird auch eins weitergesetzt
> R.Insert Shift:=xlDown
Kann ich nicht nachvollziehen, was für einen Fehler?
Andreas.
Michael Karajan
Ich habe meine Probleme wie folgt gelöst
Private Sub CommandButton1_Click()
Dim LetzteZeile As Long
ActiveSheet.Unprotect
' Letzte Zeile bestimmen und 1 dazu addieren
LetzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
' Werte in Spalten Eintragen - Spalte A = 1
ThisWorkbook.Sheets("OE_0230007").Cells(LetzteZeile, 1) = Kunde.Value
ThisWorkbook.Sheets("OE_0230007").Cells(LetzteZeile, 2) = Txt_Kto_Nr.Value
ThisWorkbook.Sheets("OE_0230007").Cells(LetzteZeile, 3) = Txt_PersNr.Value
ThisWorkbook.Sheets("OE_0230007").Cells(LetzteZeile, 4) = TxtVorname.Value
ThisWorkbook.Sheets("OE_0230007").Cells(LetzteZeile, 5) = TxtNachname.Value
ThisWorkbook.Sheets("OE_0230007").Cells(LetzteZeile, 7) = TxtGebDat.Value
ThisWorkbook.Sheets("OE_0230007").Cells(LetzteZeile, 9) = Rolle.Value
ThisWorkbook.Sheets("OE_0230007").Cells(LetzteZeile, 12) = Werbe.Value
ThisWorkbook.Sheets("OE_0230007").Cells(LetzteZeile, 14) = TxtTelVor.Value
ThisWorkbook.Sheets("OE_0230007").Cells(LetzteZeile, 15) = TxtTelNr.Value
' Formel Spalte H von der oberen Zeile Kopieren und Einfügen
Worksheets("OE_0230007").Cells(LetzteZeile - 1, 8).Copy
Worksheets("OE_0230007").Cells(LetzteZeile, 8).Insert
' Leere Zeile in den Zwischenraum einfügen
Worksheets("OE_0230007").Rows(LetzteZeile + 1).Insert Shift:=xlDown
'und Maske schließen
Unload Me
UserForm1.Hide
ActiveSheet.Protect AllowFiltering:=True
End Sub
Gruß Michael