Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1744to1748
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Daten holen aus gechlossener Datei

Daten holen aus gechlossener Datei
05.03.2020 16:48:22
Uli
Hallo Zusammen,
ich habe Mappe1 mit 3 Blättern.
Blatt 1 Frühschicht
Blatt 2 Spätschicht
Blatt 3 Nachtschicht
In allen 3 Blättern wird in Zelle M4 eine Zahl eingegeben.
dann habe ich Mappe2
Tabelle 1
Den Wert von Frühschicht aus Zelle M4 möchte ich in Zelle B4
Den Wert von Spätschicht aus Zelle M4 möchte ich in Zelle B5
Den Wert von Nachtschicht aus Zelle M4 möchte ich in Zelle B3
Ist es möglich die Daten per VBA per Button zu holen ?
Danke Uli

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten holen aus gechlossener Datei
05.03.2020 17:00:35
Hajo_Zi
Hallo Uli,
Ja, damit ist die Frage eigentlich beantwortet.
Option Explicit
Public Function GetDataClosedWB(SourcePath As String, _
SourceFile As String, sourceSheet As String, _
SourceRange As String, TargetRange As Range) As Boolean
'Holt einen Bereich aus einer _geschlossenen_ Arbeitsmappe
'Nur in VBA zu verwenden; nicht aus einer Tabellenzelle heraus
'© t.ramel@mvps.org
' wird durch die HoleDaten aufgerufen
Dim strQuelle       As String
Dim Zeilen          As Long
Dim Spalten         As Byte
On Error GoTo InvalidInput
strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!" & Range( _
SourceRange).Cells(1, 1).Address(0, 0)
Zeilen = Range(SourceRange).Rows.Count
Spalten = Range(SourceRange).Columns.Count
With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)
.Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
.Value = .Value
End With
GetDataClosedWB = True
Exit Function
InvalidInput:
MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", vbExclamation, "Get data from  _
closed Workbook"
GetDataClosedWB = False
End Function
Public Sub HoleDaten()
' Die Funktion arbeitet mit der obrigen GetDataClosedWB zusammen
Dim Pfad            As String
Dim Dateiname       As String
Dim Blatt           As String
Dim Bereich         As String
Dim Ziel            As Range
Pfad = "L:\Eigene Dateien\Hajo\Internet\Test\2009\"
Dateiname = "Beispiel Forum 30.xlsm" ' aus welcher Datei soll er holen?
Blatt = "Tabelle1"  ' von welcher Tabelle soll er holen?
Bereich = "A1:B9"   ' aus welchem Bereich soll er holen?
Set Ziel = ActiveSheet.Range("A1")  ' in welchen Bereich soll er kopieren? Genauer gesagt:  _
Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch
If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then
MsgBox "Daten importiert"
End If
End Sub
'Public Sub HoleDaten()
'    ' Die Funktion arbeitet mit der obrigen GetDataClosedWB zusammen
'    Dim Pfad            As String
'    Dim Dateiname       As String
'    Dim Blatt           As String
'    Dim Bereich         As String
'    Dim Ziel            As Range
'    Dim Razelle As Range
'    Dim LoI As Long
'    Dim Loletzte As Long
'    Dim Loletzte2 As Long
'    Set Ziel = ActiveSheet.Cells(1, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row  _
+ 1)
'    ' in welchen Bereich soll er kopieren? Genauer gesagt: _
'    Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch
'    If Range("G1")  "" Then
'        Loletzte = IIf(IsEmpty(Cells(Rows.Count, 7)), Cells(Rows.Count, 7).End(xlUp).Row, Rows. _
Count)
'        For LoI = 1 To Loletzte
'            Pfad = Cells(LoI, 7)
'            Dateiname = "hayo.xlsm" ' aus welcher Datei soll er holen?
'            Blatt = Cells(LoI, 8)  ' von welcher Tabelle soll er holen?
'            Bereich = Cells(LoI, 9)  ' aus welchem Bereich soll er holen?
'            Set Ziel = ActiveSheet.Range("A1")  ' in welchen Bereich soll er kopieren? Genauer  _
gesagt: _
'            Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht  _
auch
'            If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then
'                MsgBox "Daten importiert"
'            End If
'        Next LoI
'    End If
'End Sub


Anzeige
AW: Daten holen aus gechlossener Datei
05.03.2020 17:57:13
Uli
Danke Hajo,
bin schon etwas weiter.
Habe jetzt die 3 Abschnitte hinter einander gepackt. Er kopiert mir aber nur Die Daten in B3.
B4 und B5 bleiben leer.
Wo liegt der fehler ?
Public Sub HoleDaten()
' Die Funktion arbeitet mit der obrigen GetDataClosedWB zusammen
Dim Pfad            As String
Dim Dateiname       As String
Dim Blatt           As String
Dim Bereich         As String
Dim Ziel            As Range
Pfad = "T:\HSM\Schichtübergabe\"
Dateiname = "Schichtübergabe_MB.xlsm" ' aus welcher Datei soll er holen?
Blatt = "Frühschicht"  ' von welcher Tabelle soll er holen?
Bereich = "M4"   ' aus welchem Bereich soll er holen?
Set Ziel = ActiveSheet.Range("B4")  ' in welchen Bereich soll er kopieren? Genauer gesagt:  _
_
Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch
Blatt = "Spätschicht"  ' von welcher Tabelle soll er holen?
Bereich = "M4"   ' aus welchem Bereich soll er holen?
Set Ziel = ActiveSheet.Range("B5")  ' in welchen Bereich soll er kopieren? Genauer gesagt:  _
_
Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch
Blatt = "Nachtschicht"  ' von welcher Tabelle soll er holen?
Bereich = "M4"   ' aus welchem Bereich soll er holen?
Set Ziel = ActiveSheet.Range("B3")  ' in welchen Bereich soll er kopieren? Genauer gesagt:  _
_
Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch
If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then
MsgBox "Daten importiert"
End If
End Sub

Anzeige
AW: Daten holen aus gechlossener Datei
05.03.2020 17:03:15
UweD
Hallo
warum VBA?
Einfache Formeln:

Tabelle1
 B
4F
5S
6N

verwendete Formeln
Zelle Formel Bereich N/A
B4='X:\Temp\Test\[Mappe2.xlsx]Frühschicht'!$M$4  
B5='X:\Temp\Test\[Mappe2.xlsx]Spätschicht'!$M$4  
B6='X:\Temp\Test\[Mappe2.xlsx]Nachtschicht'!$M$4  


LG UweD
Anzeige
sorry: Mappe2 und Mappe 1 vertauscht
05.03.2020 17:05:02
UweD
AW: sorry: Mappe2 und Mappe 1 vertauscht
05.03.2020 17:33:41
Uli
Hallo Uwe,
danke für den Hinweis. Diese Formeln benutze ich schon.Leider werden die Werte erst in Mappe 2 kopiert wenn ich Mappe 2 schließe und wieder öffne. Da ist ein Klick doch besser.
Gruß Uli
AW: sorry: Mappe2 und Mappe 1 vertauscht
05.03.2020 18:34:43
volti
Hallo Uli,
falls Du noch auf der Suche bist, hier noch eine Idee zur Übernahme von den paar Werten.
Probiere mal aus; ist von mir aber ungetestet…..
Option Explicit
Sub HoleDaten()
 Dim sPfad As String
 sPfad = ThisWorkbook.Path
 With ThisWorkbook.Sheets("Tabelle1")
  .Cells(3, "B").value = GetValue(sPfad, "Mappe 1.xlsx", "Nachtschicht", "$M$4")
  .Cells(4, "B").value = GetValue(sPfad, "Mappe 1.xlsx", "Frühschicht", "$M$4")
  .Cells(5, "B").value = GetValue(sPfad, "Mappe 1.xlsx", "Spätschicht", "$M$4")
 End With
End Sub
Private Function GetValue(sPath As String, sFile As String, sSheet As String, sRange As String) As String
'Exceldatei im Hintergrund öffnen und Wert holen
 If Right$(" " & sPath, 1) <> "\" Then sPath = sPath & "\"
 With GetObject(PathName:=sPath & sFile)
   GetValue = .Sheets(sSheet).Range(sRange).value
   .Close SaveChanges:=False
 End With
End Function

viele Grüße
Karl-Heinz

Anzeige
AW: sorry: Mappe2 und Mappe 1 vertauscht
05.03.2020 18:42:02
Uli
Hallo Karl-Heinz,
danke für den Code.
Bekomme einen Laufzeitfehler : 432 Datei oder Klassenname nicht gefunden.
Unten der angepasste Code von mir .
Sub HoleDaten_NEU()
Dim sPfad As String
sPfad = ThisWorkbook.Path
With ThisWorkbook.Sheets("Tabelle1")
.Cells(3, "B").Value = GetValue(sPfad, "T:\HSM\Schichtübergabe\Schichtübergabe_MB.xlsm", "Nachtschicht", "$M$4")
.Cells(4, "B").Value = GetValue(sPfad, "T:\HSM\Schichtübergabe\Schichtübergabe_MB.xlsm", "Frühschicht", "$M$4")
.Cells(5, "B").Value = GetValue(sPfad, "T:\HSM\Schichtübergabe\Schichtübergabe_MB.xlsm", "Spätschicht", "$M$4")
End With
End Sub
Private Function GetValue(sPath As String, sFile As String, sSheet As String, sRange As String)  _
As String
'Exceldatei im Hintergrund öffnen und Wert holen
If Right$(" " & sPath, 1)  "\" Then sPath = sPath & "\"
With GetObject(PathName:=sPath & sFile)
GetValue = .Sheets(sSheet).Range(sRange).Value
.Close SaveChanges:=False
End With
End Function

Anzeige
AW: sorry: Mappe2 und Mappe 1 vertauscht
05.03.2020 18:51:00
volti
Hallo Uli,
bitte genauer hinschauen beim Aufrufen der Funktion:
Pfad und Datei sind getrennt:
.Cells(3, "B").Value = GetValue("T:\HSM\Schichtübergabe\","Schichtübergabe_MB.xlsm", "Nachtschicht", "$M$4")
oder
sPfad = "T:\HSM\Schichtübergabe"
With ThisWorkbook.Sheets("Tabelle1")
.Cells(3, "B").Value = GetValue(sPfad, "Schichtübergabe_MB.xlsm", "Nachtschicht", "$M$4")
VG KH
AW: sorry: Mappe2 und Mappe 1 vertauscht
05.03.2020 19:12:02
Uli
Danke .... es hat geklappt und läuft.
Vielehen Dank

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige