Zellen automatisch übertragen via Button

Hallo zusammen,
ich tu mich schwer mit der Makro Programmierung, deswegen hoffe ich jemand kann mir bei folgendem Problem helfen:
Es geht um eine Tabelle (1), die täglich mit verschiedenen Daten (Zahlen) manuell befüllt wird. Die Daten sollen dann automatisch via Update Button in ein neues Tabellenblatt (Tabelle 2) kopiert werden. In Tabelle 1 sollen nach dem Klick auf den Update Button die eingetragenen Daten gelöscht werden. Zusätzlich sollen die Daten in Tabelle 2 dann, falls in der Zelle bereits ein Wert steht, dazu addiert werden. Tabelle 2 ist genauso aufgebaut wie Tabelle 1.
Das heißt alles was in Tabelle 1 in Zelle C2 eingetragen wird, soll automatisch in Tabelle 2 in Zelle C2 eingetragen werden.
In Summe sind es 8 Spalten und mind. 1000 Zeilen, das heißt 8000 Zellen. Da muss es doch einen allgemeinen code geben oder?
Ich hoffe hier kann mir jemand helfen ...
Vielen Dank schonmal. :)
Viele Grüße
Jules

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim ws As Worksheet Dim ws2 As Worksheet Dim intlz As Long Dim rng As Range Dim Zelle As Range Set ws = ThisWorkbook.Sheets("Tabelle1") Set ws2 = ThisWorkbook.Sheets("Tabelle2") intlz = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row Set rng = ws.Range("A5:H" & intlz) For Each Zelle In rng If Zelle "" Then ws2.Range(Zelle.Address) = ws2.Range(Zelle.Address) + Zelle.Value Zelle.Value = "" End If Next Zelle Set rng = Nothing Set ws = Nothing Set ws2 = Nothing End Sub

Hallo Bernd,
vielen Dank fuer deine Antwort.
Es funktioniert, vielen Dank.
Ich wuerde jetzt gern noch die Farbe aendern, wenn in der Zelle sozusagen eine Aenderung vorgenommen wurde. Hab es so versucht, aber es klappt nicht.. kannst du da nochmal schnell drueber schauen bitte?

Sub test()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim intlz As Long
Dim rng As Range
Dim Zelle As Range
Set ws = ThisWorkbook.Sheets("Tabelle1")
Set ws2 = ThisWorkbook.Sheets("Tabelle2")
intlz = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set rng = ws.Range("B2:H" & intlz)
For Each Zelle In rng
If Zelle  "" Then
ws2.Range(Zelle.Address) = ws2.Range(Zelle.Address) + Zelle.Value
Zelle.Adresse.Interior.Color = RGB(180, 198, 231)
Zelle.Value = ""
End If
Next Zelle
Set rng = Nothing
Set ws = Nothing
Set ws2 = Nothing
End Sub

Ich kann das jetzt einfach auf einen Button legen und dann sollte das Makro bei Click ausgefuehrt werden oder?
Danke Danke und viele Gruesse
Juliane

Beliebteste Forumthreads (12 Monate)

Zellen automatisch übertragen via Button

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread