Datum

Titel

26.09.2025 10:29:46

Wert aus einer Zelle bei jeder Eingabe in neue Zelle

26.09.2025 08:51:00

Teilinhalt einer Zelle vergleichen

25.09.2025 23:04:12

Einen von drei möglichen Einträgen in einer Zeile suchen

25.09.2025 19:59:48

Lebenserleichternde Datei, im Bezug auf die Essensauswahl

Keine passende Antwort im Forumarchiv gefunden?

Stelle deine Frage im Live-Forum

HERBERS

Excel-Forum (Archiv)

20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Vorheriger Thread

Rückwärts Blättern

Aktuelles Verzeichnis

Übersicht Verzeichnisse

Nächster Thread

Vorwärts blättern

Inhaltsverzeichnis

Formel automatisch weiterschreiben

Forumthread: Formel automatisch weiterschreiben
6 Beiträge zu diesem Forumthread
Anzeige
209 Threads zu ähnlichen Themen
VBA Beispiele zu verwandten Themen
Top 100 Forumthreads

Forumthread: Formel automatisch weiterschreiben

18.05.2018 08:01:07

chris58

Hallo !
Ich habe bei dem u.a. File versucht mit diesem u.a. Makro eine Formel automatisch weiterzuschreiben, wenn in Spalte A ein Eintrag erfolgt. Leider ohne Erfolg. Weiß jemand, wie ich das machen könnte, um Erfolg zu haben.
Danke
https://www.herber.de/bbs/user/121688.xls

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Count = 1 Then
Application.EnableEvents = False
Range(Cells(Target.Row - 1, 4), Cells(Target.Row - 1, 18)).AutoFill _
Destination:=Range(Cells(Target.Row - 1, 4), Cells(Target.Row, 5)), _
Type:=xlFillDefault
Application.EnableEvents = True
End If
End Sub

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Formel automatisch weiterschreiben

18.05.2018 08:31:35

ChrisL
schaut Euch mal die Tel.Nr.an :-)..owT

18.05.2018 08:39:12

robert
und PLZ und Strassennr. :)

18.05.2018 08:44:29

ChrisL
AW: Danke - geht alles

18.05.2018 09:00:26

chris58
AW:sind doch nur 2 Zellen mit Formeln

18.05.2018 09:07:27

hary
Datei mit Copy zurück-Gruß

18.05.2018 08:59:20

robert

AW: Formel automatisch weiterschreiben

18.05.2018 08:31:35

ChrisL

Hi
Die Spaltenzahl der beiden Bereiche muss übereinstimmen. Ein kleines Fehlerhandling würde zudem nicht schaden...
Gemäss Vorlage:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Count = 1 Then
Application.EnableEvents = False
Range(Cells(Target.Row - 1, 4), Cells(Target.Row - 1, 18)).AutoFill _
Destination:=Range(Cells(Target.Row - 1, 4), Cells(Target.Row, 18)), _
Type:=xlFillDefault
Application.EnableEvents = True
End If
End Sub

Mit Fehlerhandling:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Count = 1 Then
On Error GoTo errorhandler:
Application.EnableEvents = False
Range(Cells(Target.Row - 1, 4), Cells(Target.Row - 1, 18)).AutoFill _
Destination:=Range(Cells(Target.Row - 1, 4), Cells(Target.Row, 18)), _
Type:=xlFillDefault
Application.EnableEvents = True
End If
Exit Sub
errorhandler:
Application.EnableEvents = True
MsgBox "Fehler"
End Sub

cu
Chris

schaut Euch mal die Tel.Nr.an :-)..owT

18.05.2018 08:39:12

robert

und PLZ und Strassennr. :)

18.05.2018 08:44:29

ChrisL

AW: Danke - geht alles

18.05.2018 09:00:26

chris58

Danke - passt nun
chris

AW:sind doch nur 2 Zellen mit Formeln

18.05.2018 09:07:27

hary

Moin
Du hast doch nur 2 Zellen mit Formeln drin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Count = 1 Then
Application.EnableEvents = False
Cells(Target.Row - 1, 4).Copy Cells(Target.Row, 4)
Cells(Target.Row - 1, 18).Copy Cells(Target.Row, 18)
Next
End If
Application.EnableEvents = True
End Sub

oder wenn mehr Formeln vorhanden:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim zelle As Range
If Target.Column = 1 And Target.Count = 1 Then
Application.EnableEvents = False
For Each zelle In Range(Cells(Target.Row - 1, 4), Cells(Target.Row - 1, 18)).SpecialCells( _
xlCellTypeFormulas)
zelle.Copy Cells(Target.Row, zelle.Column)
Next
End If
Application.EnableEvents = True
End Sub

gruss hary

Datei mit Copy zurück-Gruß

18.05.2018 08:59:20

robert

https://www.herber.de/bbs/user/121691.xls

;