Daten per Makro auf Grund eines Zelleninhaltes feststellen, kopieren und in andere Blätter einfügen

Question

Hallo zusammen,

ich habe ein ähnliches Problem:

Ich habe eine Tabelle mit 14 Tabellenblättern, die alle ähnlich aufgebaut sind.
Immer wenn ein Tabellenblatt abgeschlossen ist, will ich ein Makro ausführen, das auf
Grund eines bestimmten Zellinhalts die Zeile mit den Daten (Daten sind in mehreren
Spalten) kopiert und in alle nachfolgenden Tabellenblätter einfügt.
Beispiel:

Tabellenblatt1 enthält Daten in der Zelle C1, C2 und C4
Das Makro soll die Anzahl identifizieren in den folgenden Tabellenblättern 2 bis 14 ab
einer bestimmten Zeile 3 neue Zeilen einfügen und anschließend die kopierten Inhalte in
die eingefügten Zeilen einfügen.
Das Feststellen und Einfügen soll immer vom aktuellen Tabellenblatt, in dem das Makro
ausgeführt wird, in alle nachfolgenden Tabellenblätter erfolgen.
Also von Tabellenblatt 1 in die Tabellenblätter 2-14, von 2 in 3-14,...von 10 in 11-14.

Geht sowas, hätte da jemand eine Idee?
Ich wäre sehr dankbar :)

Answer 1

Hallo,

das lässt sich schon per Makro lösen. Soll denn nur der Inhalt der Zellen C1, C2 und C 2 kopiert werden? Und ab welcher Zeile und in welche Spalte sollen die kopierten Daten eingefügt werden?

Gruß

M.O.

Answer 2

Zunächst vielen Dank für die Antwort.

Das Einfügen in den Tabellenblättern findet immer ab Zeile 15 statt. Es sollen dabei aber nur bestimmte Zellen der Zeile eingefügt werden (nicht nur ein Feld).

Beispiel aus der aktuellen Vorlage:

Also auf Grund der Prüfung, ob in den Zellen L 15, L16 usw. etwas steht, muss der Inhalt der jeweiligen Zeile von A15 bis G15 in die nachfolgenden Tabellenblätter kopiert werden. Zusätzlich muss der Wert aus der Zelle L15 in den anderen Tabellenblättern in die Felder H15, H16 usw. eingefügt werden.

Ist das so einigermaßen verständlich? Ich könnte auch, falls gewünscht eine Datei senden. Ich weiss leider nicht, wie eine Datei hier angehängt werden kann und Screenshots kann man auch nicht einfügen.

Ich versuche es mal so zu erläutern:

Die Daten sollen ein Auszug aus dem Tabellenblatt 2 sein

Alt - - + Neu
A14,B14, C14 D14 E14 F14 G14, H14, I14, J14, K14, L14

Test1 01,2017,6815,3333,8888, 100 100 0

Test2 01,2017,6815,3333,8888, 700 200 900
Test3 01,2017,6815,3333,8888, 500 300 200

Das Makro soll jetzt prüfen, ob jeweils in den Zellen L15, L16, L17 etwas steht und wenn ja, soll es in den danach folgenden Tabellenblättern 3 bis 14 jeweils ab der Zeile 14 neue Zeilen einfügen und dann für die Zellen, für die die Prüfung zutrifft,die Inhalte der Zellen von A bis G in die weiteren Tabellenblätter einfügen.
Konkret für das o.g. Beispiel soll das Makro in den Tabellenblättern 3 bis 14

- ab Zeile 14 2 neue Zeilen einfügen
- die Inhalte der Zeilen A16 bis G16 und A17 bis G17 in die anderen Tabellenblätter einfügen und
- die Beträge in den Zellen L16 und L17 in den anderen Tabellenblättern in die Zellen in der Spalte H übernehmen

Ich hoffe, dass es dadurch etwas klarer geworden ist.
Wenn du eine Lösung hättest, wäre es eine richtig gute Erleichterung für mich.
Vielen Dank schonmal.

Viele Grüße

Answer 3

Hallo,

eine Beispieldatei kannst du nicht hier direkt hochladen, Das musst du auf einem Hoster deiner Wahl machen (z.B. hier oder hier).

Lade mal eine Beispieldatei hoch und zeige darin auch das gewünschte Ergebnis. Zeige darin bitte deutlich auf, was unter welchen Bedingungen wohin kopiert werden soll, damit man dir auch entsprechend helfen kann.

Gruß

M.O.

P.S. Hast du bereits Erfahrungen mit Makros / VBA?

Answer 4

Hallo M.O.,

ich habe die Datei hochgeladen, mit nachfolgendem Link müsstest du sie finden.
Dort habe ich auch noch die Erläuterung vorgenommen und aufgezeigt, was das Ergebnis sein soll.

http://www116.zippyshare.com/v/Nux51uVQ/file.html

Testdatei Rst..xlsm
http://www116.zippyshare.com/v/Nux51uVQ/file.html


vg

Answer 5

Hallo,

das folgende Makro gehört in ein Standard Modul deiner Arbeitsmappe:

Sub vortragen()

Dim lngZeile As Long
Dim lngEnde As Long
Dim lngAnzahl As Long
Dim lngSpalte As Long
Dim lngZaehler As Long
Dim i As Long
Dim lngAnzahlZ As Long
Dim arrUebertrag As Variant

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'im aktuellen Arbeitsblatt prüfen, wieviele Zeilen übertragen werden müssen
lngZeile = 15

'In Spalte B nach Vor Einfügen-Text suchen und feststellen
Do
lngZeile = lngZeile + 1
Loop Until Left(ActiveSheet.Cells(lngZeile, 2), 12) = "Vor Einfügen"

'Ende vor gefundener Zeile setzen
lngEnde = lngZeile - 1
'Anzahl der zu übertragenden Datensätze ermitteln
lngAnzahl = lngEnde - 15

'Array für zu übertragende Daten redimensionren
ReDim arrUebertrag(lngAnzahl, 7)

'Daten in Array einlesen
For lngZeile = 16 To lngEnde
'Prüfen, ob Spalte L nicht Null ist
If ActiveSheet.Cells(lngZeile, 12).Value <> 0 Then
'Zaehler erhöhen
lngZaehler = lngZaehler + 1
'Spalten A bis E einlesen
For lngSpalte = 1 To 5
arrUebertrag(lngZaehler, lngSpalte) = ActiveSheet.Cells(lngZeile, lngSpalte).Value
Next lngSpalte

'Spalte G
arrUebertrag(lngZaehler, 6) = ActiveSheet.Cells(lngZeile, 7).Value

'Spalte L
arrUebertrag(lngZaehler, 7) = ActiveSheet.Cells(lngZeile, 12).Value

End If

Next lngZeile

'alle Blätter der Arbeitsmappe durchlaufen
For i = ActiveSheet.Index + 1 To ThisWorkbook.Worksheets.Count
'nur wenn Name mit Rst. anfängt, dann ggf. die Daten einfügen
With Worksheets(i)

If Left(.Name, 4) = "Rst." Then
lngZeile = 15
'In Spalte B nach Vor Einfügen-Text suchen
Do
lngZeile = lngZeile + 1
Loop Until Left(.Cells(lngZeile, 2), 12) = "Vor Einfügen"

'Anzahl der vorhandenen Zeilen im Zielarbeitsblatt
lngAnzahlZ = lngZeile - 16
'letzte Zeile
lngEnde = lngZeile - 1

'Zielbereich löschen
.Range(.Cells(16, 1), .Cells(lngEnde, 15)).ClearContents

'ggf. Zeilen einfügen
If lngAnzahlZ < lngAnzahl Then
For lngZeile = 1 To lngAnzahl - lngAnzahlZ
.Rows(lngEnde + lngZeile).EntireRow.Insert
Next lngZeile
End If

'Daten einfügen
For lngZeile = 1 To lngZaehler
'Spalten A bis E
For lngSpalte = 1 To 5
.Cells(15 + lngZeile, lngSpalte) = arrUebertrag(lngZeile, lngSpalte)
Next lngSpalte
'Formel in Spalte F: =WENN(ODER(E16=5200;E16=5201);3071;WENN(E16=0;"";3070))
.Cells(15 + lngZeile, 6).FormulaLocal = "=WENN(ODER(E" & 15 + lngZeile & "=5200;E" & 15 + lngZeile & "=5201);3071;WENN(E" & 15 + lngZeile & "=0;"""";3070))"
'Spalte G
.Cells(15 + lngZeile, 7) = arrUebertrag(lngZeile, 6)
'Spalte H
.Cells(15 + lngZeile, 8) = arrUebertrag(lngZeile, 7)
'Formel für Spalte L: =RUNDEN(H16-I16-J16+K16;2)
.Cells(15 + lngZeile, 12).FormulaLocal = "=RUNDEN(H" & 15 + lngZeile & "-I" & 15 + lngZeile & "-J" & 15 + lngZeile & "+K" & 15 + lngZeile & ";2)"
'Formel für Spalte O: =WENN(N16<>0;I16+J16-N16;0)+WENN(N16=0;I16-N16;0)+WENN(N16=0;J16-N16;0)
.Cells(15 + lngZeile, 15).FormulaLocal = "=WENN(N" & 15 + lngZeile & "<>0;I" & 15 + lngZeile & "+J" & 15 + lngZeile & "-N" & 15 + lngZeile & ";0)+WENN(N" & 15 + lngZeile & "=0;J" & 15 + lngZeile & "-N" & 15 + lngZeile & ";0)"

Next lngZeile

End If

End With

Next i

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

MsgBox "Die Daten wurden in die Folgemonate übertragen", 48, "Hinweis"

End Sub

Probier den Code aber erst einmal in einer Testmappe aus.

Gruß

M.O.

Answer 6

Hallo M.O.

ich habe das, was du erstellt hast, in eine Testdatei kopiert und es scheint alles zu klappen, Hammer! Echt super.
Ich werde noch ein paar Testläufe machen und dir auf jeden Fall nochmal Bescheid geben.

Ich bin beeindruckt :)

Viele Grüße

Answer 7

Hallo M.O.

kannst du bitte mal prüfen, ob man folgendes noch einbauen kann:

- ich würde gerne die leeren Zeilen 10 bis 13 löschen. D.h. die zu übernehmenden Daten würden immer ab der Zeile 13 stehen.

- wenn ich z.B. im Febr. 10 Positionen/Zeilen habe, die ich in die Folgemonate übertrage, werden diese Zeile entsprechen den Kriterien übernommen --> funktioniert.

Wenn sich im März von diesen 10 Positionen 7 erledigen, d.h. ich habe nur noch 3 Positionen/Zeilen, die ich auf die Folgemonate übertragen muss, werden zwar die 3 Zeilen übertragen aber die leeren Zeilen werden nicht gelöscht.
Geht es, dass z.B. wenn im März nur noch 3 Zeilen sind, die übertragen werden sollen, die 3 Zeilen übertragen und die leeren Zeilen aus der vorherigen Übernahme (in diesem Fall Febr.) gelöscht werden?

- Kann man ein separates Makro einbauen, dass zwischen der 16. Zeile (16. Zeile ist alt, neu 13. Zeile) und der Zeile mit dem grauen Kasten "Vor Einfügen einer Zeile Cursor in diese Zelle positionieren" leere Zeilen einfügt?
Dabei soll in der jeweiligen Zeile in der Spalte F mit relativem Bezug folgende Formel stehen: =+WENN(ODER(E17=5200;E17=5201);3071;WENN(E17=0;"";3070))
In der jeweiligen Zeile in der Spalte L soll folgende Formel stehen: =RUNDEN(H17-I17-J17+K17;2) und
in der jeweiligen Zeile in der Spalte O die Formel =+WENN(N17<>0;I17+J17-N17;0)+WENN(N17=0;I17-N17;0)+WENN(N17=0;J17-N17;0) stehen.

An keiner anderen Stelle sollen sonst Zeilen eingefügt werden können, insbesondere zwischen Zeile 1 und 12.
Die Formatierung der neuen Zeilen soll die gleiche der bestehenden sein.
Für dieses Makro soll es einen getrennten Button geben

- Kann man ein weiteres separates Makro einbauen, dass zum Speichern gedacht ist? Es soll einen getrennten Button zum Speichern geben. Wenn dieser Knopf betätigt wird, soll das Fenster aufgehen, wie wenn ich Speichern unter auswähle und als Dateiname soll die Bezeichnung in Zelle O6 zusammen mit den Angaben Monat und Jahr aus den Zellen I6 und I8 eines jeden Tabellenblatts vorgeschlagen werden
Beispiel: Nach Betätigen des Makros Speichern im Monat März soll das Fenster aufgehen wie bei Speichern unter, dabei soll der Dateiname wie folgt lauten "Zelleninhalt O6" 03.2017

Was meinst du, kriegt man sowas auch hin?

Viele Grüße

Answer 8

Hallo,

das sind ja viele Wünsche auf einmal ;-).

Ich schaue mir das mal an und sehe, was sich machen lässt.

Gruß

M.O.

Answer 9

:)

Vielen Dank schonmal

Answer 10

Hallo,

hier der Link zur bearbeiteten Testdatei: KLICK MICH!

Um das Einfügen der Zeilen zu verhindern, habe ich mit dem Blattschutz gearbeitet.
Das Festelegen, welche Zellen für das Bearbeiten gesperrt sind, habe ich aus meinem Verständnis heraus gemacht.
Aber die Festlegungen kannst du natürlich ändern.

Probier mal, ob das alles so klappt, wie du dir das vorstellst.

Gruß

M.O.