Formel automatisch in neue Zeile kopieren

Hallo,
ich habe eine einfache Adressliste mit mehreren Einträgen. In Spalte J gebe ich die Postleitzahl ein und in den Spalten K bis M erscheint dann automatisch Ort, Bundesland und Land (SVerweis der auf ein zweites Tabellenblatt mit den Orten zugreift). Soweit so gut. Nun ist es so, dass laufend neue Einträge dazukommen und ich nicht jedes Mal für jeden neuen Eintrag die Formeln neu kopieren/runterziehen will. Ich könnte natürlich die Formeln im Vorraus für z.B. 300 Zeilen kopieren, aber das ist aufgrund des #NV auch nicht schön.
Gibt es nun also eine Möglichkeit, dass sich die Formel automatisch nach unten kopiert sobald ich in eine neue Zeile schreibe bzw. dass die Formel immer in jenen Spalten vorkommt, ohne dass ich sie bis zu einer bestimmten Zeile nach unten kopieren muss?
Ich bin für jede Hilfe sehr dankbar!
Liebe Grüße
Elias

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
versuch es mit diesem Code.
Öffne den VBA Editor (Alt+F11)
Gehe zu der Arbeitsmappe und zu der entsprechenden Tabelle (doppelclick)
Code ins rechte Fenster einfügen
Code wird bei eingabe in der Tabelle ausgeführt!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngAll As Range, rngArray As Range, rng As Range
On Error GoTo ErrorHandler:
'eingabe Bereich
Set rngAll = Intersect(Range("J2:J" & Rows.Count), Target)
'wo anders abbruch
If rngAll Is Nothing Then Exit Sub
'Events aus
Application.EnableEvents = False
'alle zusammenhängende bereiche
For Each rngArray In rngAll.Areas
'einzelne Zelle im bereich
For Each rng In rngArray
If rng.Value  "" Then 'nich leer Formel
rng.Offset(, 1).Resize(, 3).FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC10,'Orte Österreich'!R2C1:R2588C4,COLUMN(R1C[-9]),0))," & _
"VLOOKUP(RC10,'Orte Deutschland'!R1C1:R13144C4,COLUMN(R1C[-9]),0)," & _
"(VLOOKUP(RC10,'Orte Österreich'!R2C1:R2588C4,COLUMN(R1C[-9]),0)))"
Else 'leer formel löschen
rng.Offset(, 1).Resize(, 3).Value = ""
End If
Next
Next
ErrorHandler:
Application.EnableEvents = True
End Sub

Gruß Tino

Private Sub Worksheet_Change(ByVal Target As Range) Dim rngAll As Range, rngArray As Range, rng As Range On Error GoTo ErrorHandler: Me.Protect "MeinKennwort", UserInterfaceOnly:=True 'eingabe Bereich Set rngAll = Intersect(Range("J2:J" & Rows.Count), Target) 'wo anders abbruch If rngAll Is Nothing Then Exit Sub 'Events aus Application.EnableEvents = False 'alle zusammenhängende bereiche For Each rngArray In rngAll.Areas 'einzelne Zelle im bereich For Each rng In rngArray If rng.Value "" Then 'nich leer Formel rng.Offset(, 1).Resize(, 3).FormulaR1C1 = _ "=IF(ISERROR(VLOOKUP(RC10,'Orte Österreich'!R2C1:R2588C4,COLUMN(R1C[-9]),0))," & _ "VLOOKUP(RC10,'Orte Deutschland'!R1C1:R13144C4,COLUMN(R1C[-9]),0)," & _ "(VLOOKUP(RC10,'Orte Österreich'!R2C1:R2588C4,COLUMN(R1C[-9]),0)))" Else 'leer formel löschen rng.Offset(, 1).Resize(, 3).Value = "" End If Next Next ErrorHandler: Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

Formel automatisch in neue Zeile kopieren

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

320 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Formel automatisch in neue Zeile kopieren

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

320 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread