HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Entdecke rund 2 Millionen Excel-Lösungen im
Forumsarchiv
Forumbeitrag
Excel-Version des Fragestellers:
365 Business
Erfahrungslevel des Fragestellers:
Excel-Profi - VBA bescheiden
Alwin Weisangler
21.04.2026 14:54:03
AW: automatische Datenupdate erstellen
Hallo Edmund,

das was du von mir bekommen hast, ist auf Basis deiner beiden Beispieldateien geschrieben.
Was in dieser Prozedur nicht passiert ist, das Daten von Zelle zu Zelle kopiert werden, sondern einer der effizienten Wege, um Daten in möglichst großen Blöcken zu lesen und zu schreiben.

Das was ich zuletzt von dir gesehen habe hat eigentlich nichts mit den Beispieldateien zu tun.
Gehe doch mal wie folgt vor:
Setze links vor der Zeile: "End If" einen Haltepunkt --> Klicke in die Prozedur -->Starte mi F5 -->Schau einfach mal im Lokalfenster des VBA Editors in die Arrays, ob alle benötigten Werte in den Array überhaupt enthalten sind.

Wenn, wenn nein sind die falschen Zellbereiche zum Einlesen in den Array(s) zugewiesen.
Da sehe ich, dass arrA nun statt 6 inzwischen mit 12 Zellen geladen wird. Das Tabellenblatt "Vorbelegung" hat den Modulnamen Tabelle5. Mit diesem Modulnamen wird in der Rückgabe gearbeitet.

.Cells(3, 2).Resize(5, 2) = arrA bedeutet: In Zeile 3 Spalte 2 (Spalte B also Zelle B3) liegt der Ankerpunkt zum Einfügen der Werte aus arrA. Der Bereich ab Ankerpunkt wird mittels Resize definiert. Also ab Zelle B3 wird von B3:C8 mit Werten gefüllt. Jetzt sollte dir klar sein, dass da eigentlich nichts wirklich passt.

Repariere so erst mal das Lesen und Schreiben des Arrays arrA.
Dann korrigiere mit Inhaltskontrolle im Lokalfenster alle restlichen Arrays auf passende Inhalte.
Dann schauen wir weiter.


Gruß Uwe
Als Antwort auf diesen Beitrag
Edmund
21.04.2026 14:06:54
AW: automatische Datenupdate erstellen
Hallo Uwe,

leider funktioniert es nicht, schade

Habe den Code wie folgt mal aktualisiert:

Es soll nun alles in eine Tabelle übertragen werden Tabelle3 (Berechnung)
Das Einzige was funktioniert ist die Übertragung des Updatestands (dateUp)
Ich habe alle einzelnen Wert und die dazugehörigen Felder kontrolliert, stimmen alle.
Für mich etwas unklar, warum geht eine Übertragung und die restlichen Übertragungen nicht?
Ich bin ja nicht gerade die Leute in VBA darum wundert es mich, dass du nirgendwo schreibst welches Feld wohin kopiert werden soll.
Sorry, wenn es nicht geht dann muss ich es eben mit Makros machen, kopieren und einfügen.

mfg

Edmund

Sub Update()
Dim Pfad, vImp$, arrA(), arrB(), arrC(), arrD(), arrE, arrF(), dateUp As Date
Pfad = Application.GetOpenFilename("Excel Files (*.xlsx), *.xls", , "XLSx", "Auswahl", _
False)
If TypeName(Pfad) Like "Boolean" Then
MsgBox "Keine Datei gewählt!", vbInformation
Exit Sub
Else
Application.EnableEvents = False
Workbooks.Open Pfad
vImp = Right$(Pfad, Len(Pfad) - InStrRev(Pfad, "\"))
With Workbooks(vImp).Sheets("Tabelle1")

'wird in Sheet Tabelle3 (Berechnung) geschrieben
dateUp = .Range("B1") 'Updatestand (Prämien-HV-Tool B1 nach HV-Tool-Original Sheet Tabelle3 B1)
arrA = .Range("B68:C72").Value 'Baukostenindes usw. (Prämien-HV-Tool B5:C9 nach HV-Tool-Original B68:C72)
arrB = .Range("B5:C5").Value 'Beitragssätze (Prämien-HV-Tool B15:C15 nach HV-Tool-Original B5:C5)
arrC = .Range("D19:F20").Value 'Glas (Prämien-HV-Tool D18:F19 nach HV-Tool-Original D19:F20)
arrD = .Range("F33:H35").Value 'HuG (Prämien-HV-Tool G24:I26 nach HV-Tool-Original F33:H35)
.Range("F51:F53,F56:F58").NumberFormat = "General"
arrE = .Range("F51:H53").Value 'GSH oberirdisch (Prämien-HV-Tool G31:H33 nach HV-Tool-Original F51:H53)
arrF = .Range("F56:H58").Value 'GSH unterirdisch (Prämien-HV-Tool G36:H38 nach HV-Tool-Original F56:H58)

Application.DisplayAlerts = False
Application.EnableEvents = True
Workbooks(vImp).Close
Application.DisplayAlerts = True
End With
End If
With Tabelle3
.Unprotect Password:="Test"
.Cells(1, 2) = dateUp
.Cells(3, 2).Resize(5, 2) = arrA
.Protect Password:="Test"
End With
'With Tabelle1
.Unprotect Password:="Test"
.Cells(4, 2).Resize(1, 2) = arrB
.Cells(7, 4).Resize(2, 3) = arrC
.Cells(13, 7).Resize(3, 3) = arrD
.Cells(20, 7).Resize(3, 2) = arrE
.Cells(25, 7).Resize(3, 2) = arrF
.Protect Password:="Test"
End With
End Sub
Folgenachrichten
Antwort auf Beitrag erstellen
Bitte einen Anwendernamen ohne @ eingeben.
Bitte das Passwort eingeben.
Bitte eine gültige E-Mail-Adresse eingeben.
Bitte einen Betreff eingeben.
Weitere Optionen
Aktivieren, wenn die Frage/der Beitrag noch nicht beantwortet wurde und unter Listen > Offene Threads erscheinen soll.
Beispieldatei hochladen

Bitte einen Nachrichtentext eingeben.