Office: (Office 2019) Eine Datei und ein Tabellenblatt gleichzeitig füllen

Hallo zusammen.
Ich versuche aus einer Quelldatei / Tabelle (2026) gleichzeitig eine neue Tabelle (Tabelle1) und eine neue Datei ....xlsm mit Daten aus der Quelldatei zu befüllen. Die neue Datei wird beim Kopieren mit den Daten aus der Quelldatei befüllt. Das Kopieren von Tabelle "2026" nach "Tabelle1" ebenfalls in der Quelldatei funktioniert nicht. Kann mir vielleicht bei der Korrektur des VBA Code behilflich sein? Danke und Gruß M B

Code:

Sub Update1Energieverbrauch_Fest()

    Dim wbQuelle As Workbook
    Dim wbZiel As Workbook
    Dim wsQ As Worksheet
    Dim wsZ As Worksheet
    Dim pfadQuelle As String
    Dim pfadZiel As String

    ' --- Pfade definieren ---
    pfadQuelle = "C:\Users\wculm\OneDrive\Desktop\verbrauch_ab _2019.xlsm"
    pfadZiel = "C:\Users\wculm\OneDrive\Desktop\Energieverbrauch_Heizung.xlsm"

    ' --- Performance optimieren ---
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' --- Dateien öffnen ---
    Set wbQuelle = Workbooks.Open(pfadQuelle)
    Set wbZiel = Workbooks.Open(pfadZiel)

    ' --- Blätter setzen ---
    Set wsQ = wbQuelle.Worksheets("2026")      ' Quelle
    Set wsZ = wbZiel.Worksheets("Tabelle1")   ' Ziel

    ' --- Quelle berechnen, damit alle Formeln aktuelle Werte liefern ---
    wsQ.Calculate

    ' --- Falls Ziel eine Tabelle (ListObject) hat, auflösen ---
    On Error Resume Next
    If wsZ.ListObjects.Count > 0 Then wsZ.ListObjects(1).Unlist
    On Error GoTo 0

    ' --- Feste Bereiche kopieren ---
    wsZ.Range("A1").Value2 = wsQ.Range("A1").Value2
    wsZ.Range("C4:C17").Value2 = wsQ.Range("C3:C14").Value2
    wsZ.Range("E4:E15").Value2 = wsQ.Range("E2:E13").Value2

    ' --- Zieldatei speichern, Dateien bleiben offen ---
    wbZiel.Save

    ' --- Performance zurücksetzen ---
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "Daten aus '2026' wurden erfolgreich nach 'Tabelle1' kopiert und gespeichert!" & vbCrLf & _
           "Beide Dateien bleiben geöffnet.", vbInformation

End Sub

 

Hi,

wenn Du mindestens Office 2010 (idealerweise aber 2016 oder höher) hast, brauchst Du das ganze VBA Gedöns nicht. Importiere Deine Daten über das Menü Daten --> Daten abrufen --> Aus Datei --> Aus Excel Arbeitsmappe

Da beide Dateien im gleichen Ordner liegen, kannst Du statt der Arbeitsmappe auch Aus Ordner wählen.

Die weitaus interessantere Frage wäre, warum Du die Daten kopieren willst und was Du damit vorhast...

 

Moin M B,

bevor Du Dich durch endlose Menüs klickst und ganz ohne Fragengedöns "Wozu brauchst Du das?" hier eine kleine VBA-Routine, die erfüllen sollte, was Du brauchst:

Code:

Sub Importiere2025Daten_Dialog()

    Dim wbQuelle As Workbook
    Dim wbZiel As Workbook
    Dim wsQuelle As Worksheet
    Dim wsNeu As Worksheet
    Dim dateiPfad As Variant

    ' Ziel ist die aktuell geöffnete Datei (2026.xlsm)
    Set wbZiel = ThisWorkbook

    ' Datei-Auswahldialog
    dateiPfad = Application.GetOpenFilename( _
                    FileFilter:="Excel-Dateien (*.xlsm), *.xlsm", _
                    Title:="Bitte 2025.xlsm auswählen")

    ' Abbrechen gedrückt?
    If dateiPfad = False Then
        MsgBox "Vorgang abgebrochen."
        Exit Sub
    End If

    ' Datei öffnen
    Set wbQuelle = Workbooks.Open(dateiPfad)

    ' Prüfen, ob das Blatt 'Daten' existiert
    On Error Resume Next
    Set wsQuelle = wbQuelle.Worksheets("Daten")
    On Error GoTo 0

    If wsQuelle Is Nothing Then
        MsgBox "In der ausgewählten Datei wurde kein Blatt 'Daten' gefunden."
        wbQuelle.Close SaveChanges:=False
        Exit Sub
    End If

    ' Blatt komplett kopieren
    wsQuelle.Copy After:=wbZiel.Sheets(wbZiel.Sheets.Count)

    ' Das neu eingefügte Blatt ist jetzt aktiv
    Set wsNeu = wbZiel.ActiveSheet

    ' Umbenennen
    On Error Resume Next
    wsNeu.Name = "2025"
    On Error GoTo 0

    ' Quelldatei schließen (ohne Speichern)
    wbQuelle.Close SaveChanges:=False

    MsgBox "Daten erfolgreich importiert."

End Sub

Schöne Grüße

 

Hallo,

man müsste erst mal wissen was du überhaupt kopiert wird uns was in die Zieltabelle letztendlich übernommen werden soll. Die Lösung kann von recht simpel bis sehr aufwendig sein. Da muss der TO schon mehr an Informationen liefern.
Dann eine passende Prozedur mit den Erforderlichen oder PQ ist nicht das Problem.

Gruß Uwe

 

Danke für die Hilfe. Gruß M B