Excel, Zellinhalte sollen automatisch nach unten "rutschen"

Hi,

ich versuche folgendes:

Eintrag in Zelle A10 soll automatisch in Zelle A11 eingetragen werden und jeder weitere Eintrag in A10 ebenso. Die bereits vorhanden Einträge sollen dabei nach unten verschoben werden. Das selbe will ich auch in der Spalte B, C, D... usw machen. Für die Spalte A hab ich es schon geschafft, allerdings bekomme ich für die weiteren Spalten nicht hin. Kann mir jemand helfen...wäre echt super....

Soweit bin ich schon:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ErrorHandler

If Not Intersect(Target, Range("A1")) Is Nothing Then

Range("B65536").End(xlUp).Offset(1, 0).Value = Target.Value

Application.EnableEvents = False

Target.Value = ""

Target.Select

ErrorHandler:

Application.EnableEvents = True

End If

End Sub

2 Antworten

Vom Beitragsersteller als hilfreich ausgezeichnet

Oubyi, UserMod Light

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

12.03.2012, 21:32

Also:
Erstmal schreibt der hier gepostete Code alles was in A1 eingetragen wird in die Spalte B, ab B2 und zwar immer untereinander, den aktuellen Eintrag also immer in die LETZTE Zeille, nicht nach B2!
Soll das SO auch für die anderen Spalten gelten, oder soll es so laufen, wie Du es beschrieben hast?
Ich habe im Moment leider keine Zeit mehr, aber wenn Du mir hier antwortest, schaue ich mir das morgen Nachmittag auf jeden Fall noch näher an.

Woher ich das weiß:Berufserfahrung – IT-Administrator (i.R.)

Oubyi, UserMod Light

12.03.2012, 21:50

Hatte doch noch einen Moment Zeit und es hat mir keine Ruhe gelassen (;o).
Dieser Code schreibt Dir, wie von Dir beschrieben, alles was Du in Zeile 10 einträgst, egal in welcher Spalte in die Zeile 11 der gleichen Spalte und schiebt den Rest nach unten.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrorHandler
If Target.Row = 10 Then
Application.EnableEvents = False
Target.Copy
Target.Offset(1, 0).Insert Shift:=xlDown
Target.Value = ""
Application.CutCopyMode = False
Target.Select
End If
ErrorHandler:
Application.EnableEvents = True
End Sub

Hattest Du Dir das SO vorgestellt?

nixwissentu

Beitragsersteller

12.03.2012, 21:59

@Oubyi, UserMod Light

SUPER, SUPER, SUPER!

Toll wäre noch, wenn ich die Zellen 10 farbig machen könnte, damit sich diese "Eintrags-Zellen" hervorheben von der übrigen Tabelle. Aber so ist es auch schon total toll!!!!! DANKE SCHÖN

Oubyi, UserMod Light

13.03.2012, 17:08

@nixwissentu

Vielleicht so (wenn ich Dich richtig verstehe):

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrorHandler
If Target.Row = 10 Then
Application.EnableEvents = False
Target.Copy
Target.Offset(1, 0).Insert Shift:=xlDown
Target.Interior.ColorIndex = 6
Target.Offset(1, 0).Interior.ColorIndex = xlNone
Target.Value = ""
Application.CutCopyMode = False
Target.Select
End If
ErrorHandler:
Application.EnableEvents = True
End Sub

Eine andere Zahl für den ColorIndex (bis 55) ergibt eine andere Farbe.

nixwissentu

Beitragsersteller

13.03.2012, 21:52

@Oubyi, UserMod Light

Perfekt!! DANKE

Oubyi, UserMod Light

14.03.2012, 17:27

@nixwissentu

Freut mich, dass ich helfen konnten ☼
Danke fürs ☆

Iamiam

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

13.03.2012, 15:48

aktive Zelle einfärben und dann nach unten verrutschen?

activecell.interior.colorindex = 6 '6 ist gelb

activecell.insert shift:=xldown 'schiebt alles nach unterhalb, und nimmt Formelbezüge mit.

...und ganze Zeile einsetzen?
activecell.entirerow.insert 'ohne shift, weil das nicht anders geht
auch hier werden Formelbezüge mitgenommen (im Gegensatz zu copy-paste!)

eine Zelle entfernen ist übrigens activecell.delete shift:=xlup ,
im Ggs zum Tastatur-Delete, das Werte entfernt, das hieße .clearcontents (löscht nur Einträge) oder .clearformats (nur Formate) oder .clear (löscht alles)

Ähnliche Beiträge

Wie kann Makros auf mehrere Zellen anwenden?

Hallo zusammen

Ich habe von einem von euch diesen Code für mein Problem erhalten.

Public dMerk As Double

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$A$7" And IsNumeric(Target) Then

Application.EnableEvents = False

On Error Resume Next

Range("A7").Value = dMerk + Target.Value

dMerk = Range("A7").Value

Application.EnableEvents = True

On Error GoTo 0

End If

End Sub

Jetzt möchte ich diesen jedoch nicht nur auf diese eine Zellle anwenden, sondern auf viele verschiedene. Wie kann ich das machen ohne für jede Zelle das Makro kopieren und den Bezug ändern muss.

Danke im voraus

...zum Beitrag

Excel if target.column?

Hallo zusammen,

habe mal wieder ein problem mit excel.... im nachfolgenden code geht alles soweit bis auf die zwei if cods bzw. der eine der sich auf die 4 ("D") Zeile bezieht geht. der code der auf zeile 9 gerichtet ist geht einfach nicht... wenn ich anstelle 9, 8 angebe und ändere gehts. es gehen alle spalten bis auf 8. dann is sense...

kann es sein, dass nur 8 zeilen irgendwie unterstützt werden oder hab ich da was falsch gemacht?

Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
   
   If IsEmpty(Target) Then Exit Sub
   If Intersect(Target, Range("a2:h100")) _
      Is Nothing Then Exit Sub
   Application.EnableEvents = False
   On Error GoTo ERRORHANDLER
   Target = UCase(Target)
ERRORHANDLER:
   Application.EnableEvents = True

    If Target.Column = 4 Then Call Zelle11 ' Heim
    
    If Target.Column = 9 Then Call Zelle12 ' Gast
    
    
End Sub

...zum Beitrag

Excel-Code für Mehrfachauswahl in Dropdown-Listen?

Hallo zusammen,

Ich versuche gerade ein Excel-Dokument zu erstellen, bei dem eine Mehrfachauswahl aus Dropdown-Listen möglich ist. Das heißt aus einer Liste sollte es möglich sein mehrere Werte anzuwählen. Das habe ich auch mit dem untenstehenden VisualBasic-Code gemeistert. Allerdings habe ich erstens das Problem, dass auch eine Mehrfachauswahl des immer gleichen Wertes möglich ist. Theoretisch könnte also in einer Zelle x-mal derselbe Werte auftauchen. Dies soll natürlich nicht möglich sein. Bei Doppelauswahl desselben Wertes soll dieser aus der Zelle wieder verschwinden.

Mein zweites Problem ist, dass ich bislang nur 2 zwei Dropdown-Listen mit Mehrfachauswahl eingefügt bekomme. Sobald ich eine dritte Spalte versuche zu implementieren, bekomme ich eine Fehlermeldung für meinen Code.

Dadurch, dass ich mich mit dem Ganzen nicht so wirklich auskenne, wäre es sehr nett, wenn mir jemand helfen könnte.

Danke!

Bisheriger Code:

Private Sub Worksheet_Change(ByVal Target As Range)

** Mehrfachauswahl über DropDown-Liste

'** Einfügen im Code-Container des betreffenden Arbeitsblattes

'** Dimensionierung der Variablen

Dim rngDV As Range

Dim wert_old As String

Dim wertnew As String

'** Errorhandling

On Error GoTo Errorhandling

'** Mehrfachauswahl im definierten Bereich "Abteilungen" und "Themen" (Bsp. J2:J2000, I2:I2000) durchführen

If Not Application.Intersect(Target, Range("J2:J2000", "I2:I2000")) Is Nothing Then

'**Range definieren

Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)

If rngDV Is Nothing Then GoTo Errorhandling

'** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen

If Not Application.Intersect(Target, rngDV) Is Nothing Then

Application.EnableEvents = False

wertnew = Target.Value

Application.Undo

wertold = Target.Value

Target.Value = wertnew

If wertold <> "" Then

If wertnew <> "" Then

Target.Value = wertold & ", " & wertnew

End If

Application.EnableEvents = True

End If

Errorhandling:

Application.EnableEvents = True

End Sub

...zum Beitrag

Excel - Hallo, ist es möglich, dass ich einen Wert in eine Zelle schreibe und er automatisch multipliziert wird, ohne einen Bezug zu einem anderen Feld?

Hallo,

ich habe das Problem, dass ich es nicht hinbekomme, einen Wert in seiner Zelle zu multiplizieren ohne in diesem eine Formel (bspw.: =100*1.05) oder einen Bezug zu einem fremden Feld zu nutzen.

Genauer gesagt,

ich möchte die Anzahl der Quadratmeter (250qm) *( den Quadratmeterpreis (100€) * 1.05 ) zusammen rechnen ohne im Feld für den Quadratmeterpreis eine Formel drinnen stehen zu haben oder einen Bezug zu diesem. :)

AnzQM €/QM Gesamtkosten

250 100(*1.05) 26,250.00€

Habe das hier:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 5 Then '(anpassen: 1 für Spalte A, 2 für B usw.)

On Error GoTo ErrorHandler

Application.EnableEvents = False

Target.Value = Target.Value * 0.5

ErrorHandler:

Application.EnableEvents = True

End If

End Sub

im Netz gefunden, es multipliziert mir aber immer die ganze Spalte. Da ich mich überhaupt nicht mit programmieren und VBA auskenne, benötige ich dringend Hilfe.

Dafür schonmal im vor hinaus DANKE <3
Gruß Luca

...zum Beitrag

Datum in Zelle darf nicht Zukünftiges Datum enthalten und muss im Aktuellen Jahr sein?

Hallo,

verzweifelt wende ich mich an das Internet da ich leider nicht weiss wie ich dieses Problem lösen kann. Folgende Idee... / Ich möchte in der Lage sein Spalte A1-A30 ein Datum zu geben das sich nur im Aktuellen Jahr befindet und nicht in der Zukunft liegen kann. Sollte dies der Fall sein soll eine Fehlermeldung Erscheinen mit einem von mir angegebenen Text... Ich habe bereits einen Code mit verschiedenen Funktionen wie Z.B das Zelle A1-A30 die Heute Funktion anwenden jedoch editierbar ist. Leider weiss ich nicht wie ich die o.g. 2 Sachen noch in den code einbinden kann oder wie dies Funktioniert. Ich hoffe ihr könnt mir helfen mit evtl den vollständigen Code? :)

Anbei der Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A3:A30")) Is Nothing Then
If Target.Value = "" Then Target.FormulaLocal = "=HEUTE()"
Else
If Intersect(Target, Range("D3:D30")) Is Nothing Then Exit Sub
If Target.Value = "" Then Target.Value = 1 End If End Sub

...zum Beitrag

Excel: Verbessertes Logging mit VBA Makro?

Hallo Zusammen

ich verwende im Moment ein kurzes Makro, um Änderungen in einem Tabellenblatt zu loggen.

Es registriert aber nur einzelne Änderungen, nicht multi-selektion oder Löschen von Spalten. Kann ich das mit separaten Privaten Subs übernehmen?

Und kann ich aufnehmen, was die Target- und "PreVal"-Adresse war (Offset 4+5)

Code:

Dim PreVal
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
PreVal = Target.Value
 
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  
    On Error GoTo 0
    
    If Target.Value <> PreVal Then
        With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
            .Offset(1, 0) = Now
            .Offset(1, 1) = PreVal
            .Offset(1, 2) = Target.Value
            .Offset(1, 3) = Environ("Username")
        End With
    End If
 
End Sub

...zum Beitrag

Excel VBA Private Sub Worksheet_Change(ByVal Target As Range)? Help Programm vom Kollegen Bearbeitet

Habe für einen Kollegen ein Programm geschrieben. Das Problem ist nun das er vorher als Change Bedienung einen Befehl drin hat denn ich nicht ganz verstehe(und mein Programm Stört). :/ Der Code hat seinen Sinn deswegen möchte ich ihn gerne drin lassen. Hier der Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Target, Range("A7:A100")) Is Nothing Then Exit Sub
   If Target.Value <> "" Then
      Target.Offset(0, 8).Value = Date
   Else
      Target.Offset(0, 8).ClearContents
   End If

End Sub

Ich denke der Code Funktioniert so. Er Speichert in der Variable "Target" die Range A7;A100 und guck nun dann ob sie leer sind wenn ja soll er das Sub Verlassen. Ist das gebiet 0,8 nicht "ungleich" Leer soll es in die Zelle 0,8 bzw "Offset"? Das Datum reinschreiben. Ist Target 0,8 leer? Löscht es die Komplette Zeile?...

So das Programm erzeugt immer wenn man in Spalte A in eine neue Zeile schreibt an der stelle 8/bzw. H das Datum.

Das Problem ist aber das der Debugger anspringt wenn man Zeilen per Rechtsklick Zeilen Löschen rauslöscht. Und da das wiederum unschön ist wäre hilfe wirklich schön :)

mfg Dennis

...zum Beitrag

Ich möchte in der ersten Spalte das aktuelle Datum automatisch eingetragen bekommen, sobald in der selben Zeile in den Spalten B-H etwas eingetragen wird?

diesen Vba Code hab ich schon gefunden:

Private Sub Worksheet_Change(ByVal Target As Range) 'Trägt akt. Datum und Uhrzeit ein A:A ein, wenn B:B nicht leer ist 
If Not Intersect(Target.Cells(1), ActiveSheet.Columns(2).Cells) Is Nothing Then 
If Not IsEmpty(Target.Value) Then If IsEmpty(Target.Cells(1).Offset(0, -1)) Then Target.Cells(1).Offset(0, -1) = Date + Time 'kann auch Date + Time (Datum+Uhrzeit) sein 
End If 
End Sub

...zum Beitrag

Wie ändere ich die Farbe der Blattregisterkarte basierend auf mehrere Zellenwerte?

Das habe ich im Netz gefunden, aber ich brauche die Abfrage für mehrere Zellen (A1:A10)

Kann mir da jemand helfen ??

Gruß Heiko



Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
    If Target.Address = "$A$1" Then
        Select Case Target.Value
        Case "False"
            Me.Tab.Color = vbRed
        Case "True"
            Me.Tab.Color = vbGreen
        Case Else
            Me.Tab.Color = vbBlue
        End Select
    End If
End Sub

...zum Beitrag

Excel VBA Selection begrenzen?

Hallo zusammen.

Ich komme leider beim meinem Problem nicht alleine weiter.

In meiner Tabelle werden in Spalte 2 und Zeile 4 Zeichen angezeigt, sobald ein Bereich selektiert wird. Die Zeichen sollen sich allerdings nur auf die Range J7:OJ57 beschränken, auch wenn die Selektion über die Range hinausgeht.

Denn jetzt, wenn ich z.B. eine Spalte markiere, schreibt der Code mir alle Zeichen in jede Zeile der Spalte, was fatal ist.

Kann ein Profi kurz helfen? :)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("J6:OJ57")) Is Nothing Then
Dim cell As Range
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Application.EnableEvents = False
   Range("B6:B57").ClearContents
   Range("J4:OJ4").ClearContents
For Each cell In selection
  With cell
   Range(cell(.Row, 2), Cells(.Row, 2)) = ">>"
   Range(cell(4, .Column), Cells(4, .Column)) = "V"
  End With
Next
   Application.ScreenUpdating = True
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
End If
End Sub

...zum Beitrag

Excel VBA Button Enable?

Hallo Freunde,

Ich habe einen Button in Excel implementiert, der sichtbar sein soll wenn meine Zelle A1 die Zahl 2 enthält.

Der Code dafür lautet:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
  On Error GoTo ErrHandler
  Dim rngButton1 As Integer
  rngButton1 = A1
  If rngButton1 = 2 Then
  CommandButton1.Enabled = False
  Else
  CommandButton1.Enabled = True
  End If
  Application.EnableEvents = True
Exit Sub
ErrHandler:
Application.EnableEvents = True
End Sub

Der Code funktioniert an und für sich, es kommt zu keiner Fehlermeldung.
Aber der Button bleibt egal was ich einstelle, Sichtbar.

Wo liegt der Fehler?

...zum Beitrag

Exel VBA? wert automatisch löschen?

Folgenden Code habe ich..

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$E$5" Then

Range("G5").Value = Range("G5").Value + Target.Value

End If

End Sub

Wie bekomme ich es hin, das sich nach eingabe von E5 der wert automatisch wieder löscht?

danke schon mal

...zum Beitrag

VBA | UserForm öffnen, sobald Excel-Zelle (die eine Formel enthält) = 2?

Hallo,

Excel-VBA....

ich benötige Hilfe beim Thema UserForm öffnen und ständige Abfrage.

Ich habe eine Zelle mit einer Formel, der Wert, welcher raus kommt soll verglichen werden und bei z.b höher als 2 soll eine User Form geöffnet werden.

Kann mir da wer helfen? Ich bin komplett auf dem Holzweg..

Der Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$T$6" Then
If UCase(Target.Value) > 2 Then NewUserForm.Show
End If

End Sub

Devo

...zum Beitrag

Beim ändern einer bestimmten Zelle Makro erneut ausführen?

Hallo,

ich habe folgendes Anliegen: Ich möchte in Excel mit VBA etwas machen. Hier einmal der Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("j10")) Is Nothing Then
    Select Case Range("j10").Value
        Case "manuell"
            Range("s7:u7").ClearContents
        Case "Anfang & Ende"
            Range("s7").Value = Worksheets("PEPStauchung").Range("d2").Value
    End Select
End If
End Sub

Ich möchte, dass, wenn ich in Zelle S6 einen Wert ändere, das ganze erneut durchgeführt wird.

Wie binde ich das ein? Vielen Dank!!!

Syrena

...zum Beitrag

Was möchtest Du wissen?

Deinen Beitrag erstellen