automatische Datenupdate erstellen

Zum Forum Zum Forum Zum Forumthread Zum Forumthread Zum Archivthread Zum Archivthread

Forumbeitrag

Excel-Version des Fragestellers:

365 Business

Erfahrungslevel des Fragestellers:

Excel-Profi - VBA bescheiden

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

Beim Antworter bedanken Als gefällt mir markieren Als hervorragend auszeichnen

Als Antwort auf diesen Beitrag

Alwin Weisangler

20.04.2026 21:04:46

AW: automatische Datenupdate erstellen

hier noch der Code:



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")

            dateUp = .Range("B1")                    'Updatestand

            arrA = .Range("B66:C72").Value           'Baukostenindes usw.

            arrB = .Range("D5:E5").Value             'Beitragssätze

            arrC = .Range("D19:F20").Value           'Glas

            arrD = .Range("F33:H35").Value           'HuG

            .Range("F51:F53,F56:F58").NumberFormat = "General"

            arrE = .Range("F51:H53").Value           'GSH oberirdisch

            arrF = .Range("F56:H58").Value           'GSH unterirdisch

            Application.DisplayAlerts = False

            Application.EnableEvents = True

            Workbooks(vImp).Close

            Application.DisplayAlerts = True

        End With

    End If

    With Tabelle5

        .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

eine weitere zwingende Änderung ist die Variable Pfad. Diese ist natürlich Variant und nicht String, da sonst bei Abbruch Boolean nicht ausgewertet werden kann.

Gruß Uwe

Folgenachrichten

AW: automatische Datenupdate erstellen - von Alwin Weisangler am 21.04.2026 14:54:03
- AW: automatische Datenupdate erstellen - von Edmund am 22.04.2026 09:25:37
  - AW: automatische Datenupdate erstellen - von Edmund am 22.04.2026 13:02:27
    - AW: automatische Datenupdate erstellen - von Alwin Weisangler am 22.04.2026 22:04:09

Zum Forumthread

Antwort auf Beitrag erstellen

Name

Bitte einen Anwendernamen ohne @ eingeben.

Passwort

Bitte das Passwort eingeben.

Email-Adresse

Bitte eine gültige E-Mail-Adresse eingeben.

Betreff

Bitte einen Betreff eingeben.

Weitere Optionen

Als noch offen markieren.

Aktivieren, wenn die Frage/der Beitrag noch nicht beantwortet wurde und unter Listen > Offene Threads erscheinen soll.

Beispieldatei hochladen

fett 

Setzt den Text in b-Tags (Fettschrift)

Dieser Text ist in Fettschrift formatiert

So sieht das dann aus

Dieser Text ist in Fettschrift formatiert

Erklärung

Ist vor dem Anklicken der Schaltfläche kein Text markiert, ist der hervorzuhebende Text zwischen die neu generierten Tags einzufügen, andernfalls werden die Tags als Umrandung des markierten Textes gesetzt.

kursiv 

Setzt den Text in i-Tags (Kursivschrift)

Dieser Text ist in Kursivschrift formatiert

So sieht das dann aus

Dieser Text ist in Kursivschrift formatiert

Erklärung

Ist vor dem Anklicken der Schaltfläche kein Text markiert, ist der kursiv zu setzende Text zwischen die neu generierten Tags einzufügen, andernfalls werden die Tags als Umrandung des markierten Textes gesetzt.

Formel <pre>

Setzt den Text in pre-Tags

<pre>=FILTER(B2:C11;A2:A11=F1)</pre>

So sieht das dann aus

=FILTER(B2:C11;A2:A11=F1)

Erklärung

Ist vor dem Anklicken der Schaltfläche kein Text markiert, ist die Formel zwischen die neu generierten Tags einzufügen, andernfalls werden die Tags als Umrandung der markierten Formel gesetzt.

Neben der optischen Hervorhebung dient die pre-Setzung auch der Verhinderung von HTML-Problemen, die dadurch entstehen, dass in Formeln enthaltene Kleiner-/Größer-Als-Zeichen vom Browser als HTML-Tags missverstanden werden.

Code <pre><code>

Setzt den Text in pre- und code-Tags

<pre><code class="language-vba">
Option Explicit
Sub NaEndlich()
MsgBox "Hallo Welt"
End Sub
</code></pre>

So sieht das dann aus


   Option Explicit
   Sub NaEndlich()
      MsgBox "Hallo Welt"
   End Sub

Erklärung

Ist vor dem Anklicken der Schaltfläche kein Text markiert, ist die Formel zwischen die neu generierten Tags einzufügen, andernfalls werden die Tags als Umrandung der markierten Formel gesetzt.

Liste <li>

Setzt den Text in li (Listenpunkte)

<li>Erste Zeile</li>
<li>Zweite Zeile</li>
<li>Dritte Zeile</li>

So sieht das dann aus

Erste Zeile
Zweite Zeile
Dritte Zeile

Erklärung

Bitte einen Nachrichtentext eingeben.