VBA Werte aus anderer Arbeitsmappe beziehen

[Olerostock]

Hallo zusammen,

ich möchte gern in einer Arbeitsmappe "Auswertung" über einen CommandButton aus einer anderen Arbeitsmappe "Voraussage_2025_KW15" nur die Zeilen kopieren (Spalte A bis F), die in Spalte A das Datum von heute haben, sowie nur die Bezeichnung Verbund1 und Verbund2 und Verbund 3 in Spalte D aufweisen und anschließend in der Arbeitsmappe "Auswertung" in das Tabellenblatt "Voraussage" am Ende des letzten Eintrages Spalte A bis F einfügen. Beide Dateien befinden sich unter Laufwerk F/2025/Dateien. Wie kann ich dieses über einen Code hinbekommen, wobei die Arbeitsmappe Voraussage_2025_KW... sich die Zahl hinter KW wöchentlich ändert.

Kann mir da eventuell einer helfen?

Mit besten Grüßen Ole

[ws-53]

Das geht auch mit Power Query (Daten > Abfragen und Verbindungen)

[Olerostock]

Moin ws 53,

leider kenne ich mich mit power query überhaupt nicht aus.

Beste Grüße Ole

[Warkings]

Mit VBA scheinst du dich nicht besonders gut auszukennen – sonst hättest du vermutlich nicht gefragt. 

Power Query ist in dem Fall der einfachere Einstieg, da sich viele Schritte bequem über die Benutzeroberfläche zusammenstellen lassen. 
Meiner Meinung nach ist das auch stabiler als aufgezeichneter VBA-Code über den Makro-Rekorder.

[Gast 123]

Hallo

wenn du Interesse an VBA hast solltest du zwei Beispieldateien hochladen.
"Auswertung" und "Voraussage" mit 10-20 Zeilen und Lösungsvorgabe von Hand.
Die Daten können anonym sein, es geht darum den -Tabellenaufbau- zu sehen.
Die Datei wird keiner nachbauen.

mfg Gast 123

[Egon12]

Hallo,

ein Schuss ins Blaue:

Code:

Option Explicit
    Private Const Datei As String = "Voraussage_2025_KW15.xlsx"
    Private arr()
   
Sub DateiLesen()
    Dim oDatei$, Pfad$
    Pfad = ThisWorkbook.Path & "\" & Datei   ' ggf. anpassen
    Application.Workbooks.Open (Pfad)
    Application.ScreenUpdating = False
    oDatei = Mid(Pfad, InStrRev(Pfad, "\") + 1, Len(Pfad))
    arr = Workbooks(oDatei).Sheets(1).UsedRange.Value
    Application.Workbooks(oDatei).Close
    DatenAuslesen
    Application.ScreenUpdating = True
End Sub

Private Sub DatenAuslesen()
    Dim i&, j&, k&, arrList()
    ReDim arrList(LBound(arr) To UBound(arr), LBound(arr, 2) To UBound(arr, 2))
    For i = LBound(arr) To UBound(arr)
        If arr(i, 1) = Date And (arr(i, 4) = "Verbund1" Or arr(i, 4) = "Verbund2" Or arr(i, 4) = "Verbund3") Then
            k = k + 1
            For j = LBound(arr, 2) To UBound(arr, 2)
                arrList(k, j) = arr(i, j)
            Next j
        End If
    Next i
    With Tabelle1
        .Cells(2, 1).Resize(k, UBound(arrList, 2)) = arrList
    End With
End Sub

Gruß Uwe

[Olerostock]

Moin Egon,

anbei die beiden Dateien.
In der Datei "Auswertung Monat April 2025" sollen die Daten aus der Datei "Voraussage_2025_KW14" über den Commandbutton am Ende dann eingefügt werden.

Beste Grüße
Ole

[knobbi38]

Hallo,

Uwe hatte zwar schon eine Lösung, hier aber mal eine Variante mit Autofilter:

Code:

Sub ImportData()
  Dim strFilename As String
  Dim wsh As Worksheet
  Dim wkb As Workbook
 
  Const FMT_WKB_NAME As String = "X:\Voraussage_{0}_KW{1}.xlsx"   ' <--- Anpassen !!!
  Const SHEETNAME As String = "Tabelle1"

  ' Tabelle für die Auswertung
  Set wsh = Worksheets(SHEETNAME)
 
  ' Quelldateinamen aus Jahr und Kalenderwoche zusammensetzen
  strFilename = Replace(FMT_WKB_NAME, "{0}", Format$(Date, "YYYY"))
  strFilename = Replace(strFilename, "{1}", CStr(WorksheetFunction.WeekNum(Date, 2)))
  Debug.Print "Quelldatei: "; strFilename
 
  ' Quelldatei öffnen
  Set wkb = Workbooks.Open(strFilename, , True)
 
  ' Daten übernehmen
  TransferData wkb.Worksheets(SHEETNAME), wsh
 
  ' Quelldatei schließen
  wkb.Close SaveChanges:=False
  Set wkb = Nothing
End Sub

Private Sub TransferData( _
    ByRef wshSource As Worksheet, ByRef wshDestination As Worksheet)
 
  Dim nextRow As Long
 
  ' Autofilter setzen
  With wshSource.Range("A:F")
    .AutoFilter 1, xlFilterToday, xlFilterDynamic
    .AutoFilter 4, Array("Verbund1", "Verbund2", "Verbund3"), xlFilterValues
  End With
 
  ' Nächste freie Zeile bestimmen
  nextRow = wshDestination.Cells(Rows.Count, 1).End(xlUp).Row + 1
 
  ' Gefilterte Daten kopieren
  wshSource.UsedRange.SpecialCells(xlCellTypeVisible).Copy _
    Destination:=wshDestination.Range("A" & nextRow)
   
  ' Autofilter zurücksetzen
  wshSource.AutoFilter.ShowAllData
End Sub

Wenn du die Kalenderwoche vorgeben möchtest, mußt du die den Teil. wo der Dateiname zusammengesetzt wird, an deine Bedürfnisse anpassen.

Gruß Knobbi38

[Olerostock]

Hallo Uwe,

recht herzlichen Dank für deine Hilfe und ich werde es in meiner Datei einmal umsetzen und melde mich dann dazu noch einmal.

Gruß Ole

---

Hallo Knobbi38,

recht herzlichen Dank für deine Hilfe und ich werde auch deine Lösung in meiner Datei einmal umsetzen und melde mich dann dazu noch einmal.

Gruß Ole

[Gast 123]

Hallo

amüsant wie schnell die Kollegen waren.  Konnte es nicht sein lassen meinen Senf mit dazu zugeben.

@Egon12  Der Code von Egon12 hat mich schwer beeindruckt.  Da juckte es mich in den Fingern ihn zu testen!

@Olerostock  Mir fiel auf dass das Ergebnis von Egon12 in der falschen Tabelle landete. Tabelle1 = Makros!

Ich habe die Tabellen Namen umbenant, und den Code von Egon modifiziert.  Mich störte Const = Datei!
Einfacher ist es die Datei in einer Zelle neben dem Button anzugeben, damit der Code für alle Dateien läuft.
Du bekommst auch angezeigt ob die Daten schon übertragen wurden. Mit dem Stand der letzten Kopie.

Wie gefällt dir jetzt der Code von Egon12??  Ist der Klasse??
Mit Array ist er Spitze, das habe ich nicht so drauf wie er.

mfg Gast 123

---

Nachtrag:  ich habe gelesen das die Daten unten angehangen werden sollen.  Ist das richtig??
Frage:  Sollen die Daten mit 0, 0 in Spalte E+F auch übertragen werden?  Ist das richtig??