Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
1460to1464
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Kopieren von Formeln mit Bedingung

Kopieren von Formeln mit Bedingung
29.11.2015 15:14:11
EasyD

Hallo Zusammen
ich bin gerade dabei, mir aus diversen in Internetforen gefundenen Code-Bruchstücken mein Marko zu bauen. Das ganze tatsächlich selbst zu bauen schaffe ich noch nicht, bin Autodidakt was VBA angeht.....
Ich habe eine Spalte I, in der entweder "gebucht" oder nichts steht.
Wenn dort nichts steht, dann sollen die Spalten A bis G der ersten Zeile darüber (= die letzte Zeile, in der noch "gebucht" steht) einfach eins nach unten in die soeben gefundene Zeile ausgefüllt werden. Klingt an sich nicht so kompliziert, ist es aber für mich.
Hintergrund ist, dass der Kenner "gebucht" nach diesem Kopiervorgang durch einen weiteren Vorgang erst gesetzt wird.
Der bisherige Code dazu:

Sub Test()
Dim ums As Worksheet, buch As Worksheet
Dim x As Long, y As Long, lngZeilen As Long
Dim lnterstefrei As Long
Set ums = Worksheets("Umsatzliste")
Set buch = Worksheets("Buchungsliste")
lngZeilen = ums.Cells(ums.Rows.Count, 2).End(xlUp).Row
x = 2
For y = 1 To lngZeilen
If ums.Cells(y, 9).Value Like "gebucht" Then
'bei "gebucht" nichts machen, sonst:
Else
Worksheets("Umsatzliste").Select
'jetzt fehlt noch die Funktion - wenn die gebucht-Zelle (=Else) leer ist, dann nimm die Spalten  _
A bis G von der ZEILE DARÜBER und kopiere sie eins nach unten
'Kopieren der Spaten A bis G (=die soeben mit der noch fehlenden Funktion erstellten Zellen):
ums.Range(Cells(y, 1), Cells(y, 7)).copy
'Einfügen der kopierten WERTE in die Spalten A bis G der Buchungsliste:
Worksheets("Buchungsliste").Select
buch.Cells(buch.Cells(Rows.Count, 2).End(xlUp).Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'setzen des Kenners "gebucht" nach Durchführung dieser Aktion
ums.Cells(y, 9).Value = "gebucht"
lngY = lngY + 1 'lngy + 1
x = x + 1
End If
Next y
End Sub

ich bin mal gespannt was so für Lösungsansätze kommen. Ich freu mich auf eure Hilfe.
Grüße

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

Betreff
Datum
Anwender
Anzeige
ungetestet
29.11.2015 18:00:20
Michael
Hi EasyD,
1. sind die Worksheet("..").Select nicht nötig, da Du ja über die Variablen "ums" und "buch" direkt auf die Tabellenblätter zugreifst - einfach auskommentiert.
2. weißt Du ja bereits, wie Du einen Bereich kopierst:
ums.Range(Cells(y, 1), Cells(y, 7)).copy

Die Zeile vorher ist schlicht jeweils y-1, also so:
ums.Range(Cells(y-1, 1), Cells(y-1, 7)).copy

Weil die Schleife ab y=1 läuft, *könnte* es aber sein, daß, wenn hier nix steht, Cells(1-1,..) kopiert werden soll, Cells(0,..) gibt es aber nicht.
Alles zusammen *könnte* (wie gesagt, ungetestet) etwa so funktionieren:
Sub Test()
Dim ums As Worksheet, buch As Worksheet
Dim x As Long, y As Long, lngZeilen As Long
Dim lnterstefrei As Long
Set ums = Worksheets("Umsatzliste")
Set buch = Worksheets("Buchungsliste")
lngZeilen = ums.Cells(ums.Rows.Count, 2).End(xlUp).Row
x = 2
For y = 1 To lngZeilen
If not ums.Cells(y, 9).Value Like "gebucht" Then
If y >1 then
ums.Range(ums.Cells(y-1, 1), ums.Cells(y-1, 7)).copy ums.Cells(y, 1)
else
msgbox "y=1; das geht nicht."
End If
End if
ums.Range(ums.Cells(y, 1), ums.Cells(y, 7)).copy
'Einfügen der kopierten WERTE in die Spalten A bis G der Buchungsliste:
buch.Cells(buch.Cells(buch.Rows.Count, 2).End(xlUp).Row + 1, 1). _
PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'setzen des Kenners "gebucht" nach Durchführung dieser Aktion
ums.Cells(y, 9).Value = "gebucht"
lngY = lngY + 1 'lngy + 1
x = x + 1
End If
Next y
End Sub
Schöne Grüße,
Michael
P.S.: wenn es nicht läuft, lade bitte ne Beispieldatei "zum Spielen" hoch.

Anzeige
Nachtrag
29.11.2015 18:10:14
Michael
Hi, ich habe übersehen, daß es sich um Formeln handelt.
Also füge sie dann entweder (wie weiter unten in Deinem Code) mit PasteSpecial ein oder ersetze den kompletten If-Block wie folgt:
If Not ums.Cells(y, 9).Value Like "gebucht" Then
If y > 1 Then
ums.Range(ums.Cells(y, 1), ums.Cells(y, 7)).Value = _
ums.Range(ums.Cells(y - 1, 1), ums.Cells(y - 1, 7)).Value
Else
MsgBox "y=1; das geht nicht."
End If
End If
Schöne Grüße,
Michael

AW: Nachtrag
01.12.2015 21:07:28
EasyD
Hallo Michael
Danke für die Mühe - ich hatte aber noch einen Geistesblitz bevor ich deine Antwort gelesen habe.
Also:
Sub Test()
Dim ums As Worksheet, buch As Worksheet
Dim x As Long, y As Long, lngZeilen As Long
Dim lnterstefrei As Long
Set ums = Worksheets("Umsatzliste")
Set buch = Worksheets("Buchungsliste")
Worksheets("Umsatzliste").Select
Range("A3:H3").Select
Selection.copy
Range("J1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
lngZeilen = ums.Cells(ums.Rows.Count, 2).End(xlUp).Row
x = 2
For y = 1 To lngZeilen
'If IsEmpty(ums.Cells(y, 10)) = True Then
If ums.Cells(y, 9).Value Like "gebucht" Then
'bei "gebucht" nichts machen, sonst:
Else
'Kopieren der Spaten A bis G (=die soeben mit der noch fehlenden Funktion erstellten Zellen):
ums.Range(Cells(y, 1), Cells(y, 7)).copy
'und Einfügen der kopierten WERTE in die Spalten A bis G der Buchungsliste:
buch.Cells(buch.Cells(Rows.Count, 2).End(xlUp).Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ums.Cells(y, 9).Value = "gebucht"
lngY = lngY + 1 'lngy + 1
x = x + 1
End If
Next y
End Sub

Ist sicher nicht die eleganteste Lösung und ich habe deinen Code jetzt auch nicht ausprobiert. Ich habe einfach mal wieder den Makro-Recorder zuhilfe genommen ;)
Aber danke für's drüber schauen. Ich bin hier im Forum echt noch nie enttäuscht worden.
Traumhaft!
Beste Grüße
Easy

Anzeige
Danke für die Rückmeldung, owT
01.12.2015 21:18:51
Michael

316 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige