speedy132
Goto Top

Zellen aus anderer Excel-Mappe mit vba auslesen

Hallo zusammen,

Ich habe eine Arbeitsmappe in der ich Werte aus einer anderen geschlossenen Arbeitsmappe auslesen möchte. Das ganze per Button. Super wäre es noch, wenn ich der Funktion den Dateinamen übergeben könnte, da der sich monatlich ändert, also von LDS März nach LDS April etc.
Die Werte zum Auslesen stehen immer in den Zellen A2; F3; K1-4
Die Mappe besteht aus mind. 20 Tabellenblättern und in jeder stehen die Werte exakt in den oben genannten Zellen.
In der neuen Mappe möchte ich die Werte alle untereinander stehen haben.
A1 Nummer
B1 Gesamt
C1 Inland
D1 Ausland
E1 Nicht EU
F1 Bezeichnung
Habe schon ein bissel rumprobiert und Makros geschrieben, wo ich eine Zelle bzw. einen Bereich auslesen kann. Allerdings das jetzt so zu gestalten, das ich automatisch alle Tabellenblätter etc auslesen kann, das übersteigt mein begrenztes vba Wissen.
Wie gehe ich da vor?
96be637f3307b9517be9e16c15f8bfc2

Content-ID: 269466

Url: https://administrator.de/forum/zellen-aus-anderer-excel-mappe-mit-vba-auslesen-269466.html

Ausgedruckt am: 11.04.2025 um 23:04 Uhr

Naderio
Naderio 17.04.2015 aktualisiert um 14:14:27 Uhr
Goto Top
Kannst du es nicht einfach ohne makro machen?

Die Zelle in einem beliebigen Blatt nehmen und dann:

=NameDesBlatts!A5

mit dem ! dazwischen.

bei Blättern mit Leerzeichen müssen Hochkommata verwendet werden:

='Name Des Blatts'!A5


LG
116301
Lösung 116301 17.04.2015, aktualisiert am 22.04.2015 um 09:01:08 Uhr
Goto Top
Hallo speedy132!

Sollte in etwa so gehen:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Option Explicit

Private Const FilePath = "V:\LDS Tabelle"       'Ordnerpfad  
Private Const CellsCopy = "A2,F3,K1,K2,K3,K4"   'Copy-Zelladressen  

Private Sub DatenImport()
    Dim aData As Variant, sFileName As Variant
    
    ChDrive Left(FilePath, 2):  ChDir FilePath
    
    sFileName = Application.GetOpenFilename("Excel Dateien (*.xls;*.xlsx), *.xls;*.xlsx")  
    
    If sFileName <> False Then
        ActiveSheet.UsedRange.ClearContents
        aData = GetValues(sFileName)
        Range("A1").Resize(UBound(aData, 1), UBound(aData, 2)).Value = aData  
    End If
End Sub

Private Function GetValues(ByRef sFileName) As Variant
    Dim oWkb As Workbook, oWks As Worksheet, oData As Object
    Dim aTemp As Variant, aData As Variant, i As Integer
    
    aData = Split(CellsCopy, ",")  
    ReDim aTemp(UBound(aData))
    
    Set oWkb = GetObject(sFileName)
    Set oData = CreateObject("Scripting.Dictionary")  
    
    For Each oWks In oWkb.Sheets
        For i = 0 To UBound(aData)
            aTemp(i) = oWks.Range(aData(i)).Value
        Next
        oData.Add oData.Count, aTemp
    Next
    
    oWkb.Close False
    
    With WorksheetFunction
        GetValues = .Transpose(.Transpose(oData.Items))
    End With
End Function
Grüße Dieter
speedy132
speedy132 22.04.2015 aktualisiert um 09:01:57 Uhr
Goto Top
Hi Eintagsfliege,

hatte Urlaub, deshalb habe ich mich nicht gemeldet.

Herzlichen Dank für den Code. Genauso sollte es aussehen.
Absolut flexibel und auch auf andere Projekte übertragbar.

Super

Gruß
Marcus