Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ein Wert in die nächste freie Zeile einfügen

Forumthread: Ein Wert in die nächste freie Zeile einfügen

Ein Wert in die nächste freie Zeile einfügen
13.12.2015 15:18:41
Arek

Hallo Zusammen,
Ich hoffe, dass jemand von Euch mir mit folgendem Problem helfen konnte. Ich möchte nämlich Werte in die Zellen C26:D26 angeben und den Wert sollte in die nächste freie Zelle (ab J25:K25) eingefügt werden. Die Werte sollten nacheinander bis zu 13. Werten eingefügt werden. Wenn ich der Makro ausführe, werden die Werte in die Zeilen K25:L25 eingetragen. Außerdem, wenn ich ein neuer Wert eintragen möchte, überschreibt sich die erste Reihe (K25:L25). Könnte mir vielleicht jemand helfen? Leider nach ein paar Stunden kann ich nicht mehr nachvoliziehen, was ich falsch mache :(.

Sub Wariant()
Dim WSDane  As Worksheet
Dim rgBereich As Range
Set WSDane = ThisWorkbook.Worksheets("Dane")
Set rgBereich = Range("J25:K37")
WSDane.Range("C26:D26").Copy
rgBereich(Cells(1, 1) & WSDane.Cells(WSDane.Rows.Count, 10).End(xlUp).Row + 1).PasteSpecial  _
_
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("C26:D26").ClearContents
Range("D29").Value = "Ready"
End Sub
Vielen Dank!

Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ein Wert in die nächste freie Zeile einfügen
13.12.2015 22:04:38
fcs
Hallo Arek,
etwa wie folgt sollte es funktionieren
Sub Wariant()
Dim WSDane  As Worksheet
Dim rgBereich As Range
Dim Zeile As Long
Set WSDane = ThisWorkbook.Worksheets("Dane")
With WSDane
Set rgBereich = .Range("J25:K37")
.Range("C26:D26").Copy
Zeile = .Cells(.Rows.Count, rgBereich.Column).End(xlUp).Row + 1
If Zeile <= rgBereich.Row Then Zeile = rgBereich.Row + 1
If Zeile > rgBereich.Row And Zeile < (rgBereich.Row + rgBereich.Rows.Count) Then
.Cells(Zeile, rgBereich.Column).PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range("C26:D26").ClearContents
.Range("D29").Value = "Ready"
End If
Application.CutCopyMode = False
End With
End Sub
Gruß
Franz

Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige