Von einer Tabelle in andere automatisch übernehmen

Question

Guten Morgen,

ich habe folgendes Problem:

In einer Tabelle(1) werden Werte eingegeben (von Spalte E-J immer Zeilenweise)
In welche Zeile etwas eingegeben wird ist willkürlich.
Das Eingegebene soll dann in einer anderen Tabelle(2) automatisch übernommen werden und eine leere Zeile soll darüber erscheinen.
Sozusagen archiviert werden.
Die Werte von Tabelle1 werden aber nicht archiviert sondern immer mal wieder überschrieben...
Diese sollen dann per Button übernommen werden (in Tabelle 2)

Ich kenne mich leider nicht sehr gut mit VBA/Makros aus und würde mich über eure Hilfe sehr freuen!!!

lg Carina

Answer 1

Hallo Carina,

wo in Tabelle2 sollen die kopierten Daten denn eingefügt werden? In Spalte A oder auch in die Spalten E bis J?

Wie stellst du dir das Kopieren vor?

In welche Zeile etwas eingegeben wird ist willkürlich.

Dann würde es sich anbieten, mit dem Druck auf den Botton die Zellen E bis J der Zeile zu kopieren, in der gerade der Cursor steht.

Und die Datensätze sollen immer am Ende, getrennt durch eine Leerzeile vom letzten Datensatz eingefügt werden?

Gruß

M.O.

Answer 2

Hallo M.O

ja es soll ebenfalls in Spalte E-J eingetragen werden .

Wegen des Kopierens, es soll nur das Kopiert werden, was geändert wurde in der Liste. Die anderen Werte sind in dem Moment egal.
Das Geänderte soll dann in Tabelle 2 überhalb der letzten Änderung erscheinen.

Die Leerzeile nur deshalb, damit der neue Wert dort eingetragen werden kann.

Gruß

Carina

Answer 3

Hallo Carina,

soll bei einer Änderung einer Zelle der ganze Bereich E - J kopiert werden oder nur die einzelne Zelle?

Das Geänderte soll dann in Tabelle 2 überhalb der letzten Änderung erscheinen.

Du willst also, dass Excel automatisch alle gemachten Änderungen erkennt, wenn der Button gedrückt wurde? Das könnte aber, je nach Datenumfang, etwas Rechenzeit in Anspruch nehmen.

Gruß

M.O.

Answer 4

Hallo M.O

ja es soll der ganze Bereich kopiert werden.

In Tabelle 1 ist eine Maske vorgegeben. Da kann nur von B2:J2 etwas eingetragen werden.
Das soll dann in der anderen Tabelle(2) auch von B2:J2 kopiert werden.
Beim nächsten mal ändern in Tabelle 1 B2:J2 soll es einfach eine Zeile drüber erscheinen.
Das gleiche soll aber auch geschehen, wenn z.B. B10:J10 gändert wird.

lg Carina

Answer 5

Hallo Carina,

in deiner Frage ging es um die Zelle E bis J. In deiner letzten Antwort um die Zellen B bis J. Was ist richtig?

Müssen im Zellbereich B bis J alle Zellen gefüllt werden, oder kann es auch Leerzellen geben?

Gruß

M.O.

Answer 6

Hallo M.O,

Gefüllt wird nur E-J
Kopiert muss aber B-J.

Es müssten alle Zellen gefüllt sein und es gibt keine leeren Zellen

lg Carina

Answer 7

Hallo Carina,

das folgende Makro gehört in das VBA-Projekt der Arbeitsmappe, in der eine Listen stehen:

Private Sub Workbook_Open()

Dim lngLetzte As Long

'Name des Arbeitsblattes, in das die Eintragungen erfolgen, die kopiert werden sollen
With Worksheets("Tabelle1")
'letzte Zeile in Spalte B ermitteln
lngLetzte = .Cells(Rows.Count, 2).End(xlUp).Row
'vorhandene Daten der Spalten E bis J in Array arrUr einlesen
arrUr = .Range(.Cells(2, 5), .Cells(lngLetzte, 10))
End With

End Sub

Den Namen der Tabelle (hier Tabelle1) in der die Eintragungen gemacht werden musst du natürlich auf deine Verhältnisse anpassen.

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

Global arrUr As Variant

Sub kopieren()

Dim lngQLetzte As Long
Dim lngZaehler As Long
Dim arrNeu As Variant
Dim arrCopy As Variant
Dim wsQuelle As Worksheet
Dim wsZiel As Worksheet
Dim u As Long
Dim n As Long
Dim s As Long

'Blätter definieren
Set wsQuelle = ThisWorkbook.Worksheets("Tabelle1") 'Arbeitsblatt aus dem die Daten kopiert werden
Set wsZiel = ThisWorkbook.Worksheets("Tabelle2") 'Arbeitsblatt in der die geänderten Daten kopiert werden sollen

With wsQuelle
'letzte Zeile im Quell-Arbeitsblatt feststellen
lngQLetzte = .Cells(Rows.Count, 2).End(xlUp).Row
'Spalten B bis J einlesen
arrNeu = .Range(.Cells(2, 2), .Cells(lngQLetzte, 10))
End With

'Array für Sätze redimensionieren, die in das Zielarbeitsblatt übertragen werden müssen
ReDim arrCopy(lngQLetzte)

'Daten vergleichen
For u = 1 To UBound(arrUr, 1)
For n = 1 To UBound(arrNeu, 1)
For s = 1 To 6
If arrUr(u, s) <> arrNeu(n, s + 3) Then
lngZaehler = lngZaehler + 1
arrCopy(lngZaehler) = n
Exit For
End If
Next s
Next n
Next u


With wsZiel
'Zeilen am Anfang einfügen
.Rows("2:" & 1 + lngZaehler).Insert Shift:=xlDown
'geänderte Daten einfügen
For n = 1 To lngZaehler
For s = 1 To 9
.Cells(1 + n, 1 + s) = arrNeu(arrCopy(n), s)
Next s
Next n
End With

'für ggf. weiteren Durchlauf Daten wieder in arrUr einlesen
'erst einmal arrUr leeren
Erase arrUr

'Daten wieder einlesen
With wsQuelle
'letzte Zeile in Spalte B ermitteln
lngQLetzte = .Cells(Rows.Count, 2).End(xlUp).Row
'vorhandene Daten der Spalten E bis J in Array arrUr einlesen
arrUr = .Range(.Cells(2, 5), .Cells(lngQLetzte, 10))
End With

End Sub

Auch hier musst die Dateinamen für die Quell- und Zieldatei noch anpassen. Dieses Makro kannst du deinem Buttom einfügen.
Probiere am besten mal in einer Testdatei aus, ob das Makro so funktioniert, wie du willst.

Gruß

M.O.