Nächste Zeile

Forumthread: Nächste Zeile

Nächste Zeile

Michel

Hallo zusammen
Ich komme nicht weiter.
Ich möchte aus Tabelle1 die Werte A1 (Datum) und B1 (Wert) nach Tabelle2 kopieren. Folgende Bedingunen sollten erfüllt sein:
- falls Datum in Tabelle2 schon besteht, dann überschreiben
- falls das Datum noch nicht besteht, dann in die nächste Zeile kopieren.
Ich bekomme das nur für eine zweite Zeile hin.... Wie kann ich das lösen, so dass in Tabelle2 die Daten und Werte historisch aufgelistet werden?
Besten Dank für die Unterstützung.
Anbei der Code:

Sub Kopieren()
Dim i As Integer
ende = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To ende
If Sheets(1).Range("A" & i).Value > 0 Then
Sheets(2).Range("A" & i + 1).Value = Sheets(1).Range("A" & i).Value
Sheets(2).Range("b" & i + 1).Value = Sheets(1).Range("b" & i).Value
End If
Next i
ende = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
For a = 1 To ende
If Sheets(2).Range("b" & a).Value = "" Then
Sheets(2).Rows(a).Delete
End If
Next a
End 

Sub

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Nächste Zeile

Matthias
AW: Nächste Zeile

Michel
AW: Nächste Zeile

Michel
AW: Nächste Zeile

Matthias

AW: Nächste Zeile

08.06.2011 15:16:16

Matthias

Hallo Michel,
mein Vorschlag:

Sub Kopieren()
Dim shQ As Worksheet, shD As Worksheet
Dim zeile As Long
Set shQ = Sheets("Tabelle1")
Set shD = Sheets("Tabelle2")
zeile = -1
On Error Resume Next 'Fehler abfangen (wenn Datum nicht existiert)
zeile = WorksheetFunction.Match(shQ.Range("A1"), shD.Columns(1), 0)
On Error GoTo 0
If zeile = -1 Then zeile = shD.Cells(shD.Rows.Count, 1).End(xlUp).Row + 1
With shD
.Cells(zeile, 1) = shQ.Range("A1")
.Cells(zeile, 2) = shQ.Range("B1")
End With
End Sub

Gruß Matthias

AW: Nächste Zeile

08.06.2011 16:28:00

Michel

Hallo Matthias
Besten Dank. Werde es gleich mal ausprobieren.
Gruss Michel

AW: Nächste Zeile

08.06.2011 17:20:19

Michel

Hallo Matthias
Funktioniert bestens. Wie kann ich nun weitere Worksheets dazunehmen?
D.h. Die Daten für ein weiteres Worksheet befinden sich ebenfalls in Tabelle1 einfach jeweils in der nächsten Zeile.
Besten Dank.

AW: Nächste Zeile

08.06.2011 17:51:01

Matthias

Hallo Michel,
wenn das öfter vorkommt, geht es besser mit einer Prozedur, der Argumente übergeben werden können:


Sub KopierenNach(rngDatum As Range, rngWert As Range, shZiel As Worksheet)
Dim shQ As Worksheet, shD As Worksheet
Dim zeile As Long
zeile = -1
On Error Resume Next 'Fehler abfangen (wenn Datum nicht existiert)
zeile = WorksheetFunction.Match(rngDatum, shZiel.Columns(1), 0)
On Error GoTo 0
If zeile = -1 Then zeile = shZiel.Cells(shZiel.Rows.Count, 1).End(xlUp).Row + 1
With shZiel
.Cells(zeile, 1) = rngDatum
.Cells(zeile, 2) = rngWert
End With
End Sub
Sub Test()
KopierenNach Worksheets("Tabelle1").Range("A1"), Worksheets("Tabelle1").Range("B1"), Worksheets( _
"Tabelle2")
KopierenNach Worksheets("Tabelle1").Range("A2"), Worksheets("Tabelle1").Range("B2"), Worksheets( _
"Tabelle3")
End Sub

Gruß Matthias

Beliebteste Forumthreads (12 Monate)

Forumthread: Nächste Zeile

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread