AW: Daten aus anderer Mappe auslesen - Nr. 2
06.10.2018 17:53:22
Werner
Hallo Andreas,
ich will mal nicht so sein:
Public Sub Daten_holen_Bewertung()
Dim strPfad As String, strDatei As String, raSpalte As Range
Dim wbQuelle As Workbook, loSuchbegriff As Long, boGefunden As Boolean
'Pfad an deine Bedürfnisse anpassen
strPfad = "C:\Ordner\Unterordner\UnterUnterordner\"
strDatei = "Bewertung_August.xlsx"
loSuchbegriff = ActiveSheet.Range("J1")
'Bildschirmaktualisierung aus
Application.ScreenUpdating = False
'Datei öffnen
Set wbQuelle = Workbooks.Open(strPfad & strDatei)
With wbQuelle.Worksheets("Tabelle1")
'Suche nach loSuchbegriff in Zeile 2
Set raSpalte = .Rows("2:2").Find(what:=loSuchbegriff, LookIn:=xlValues, lookat:=xlWhole)
'wenn gefunden dann
If Not raSpalte Is Nothing Then
'bei Fund Variable auf Wahr setzen
boGefunden = True
'Daten übertragen
ThisWorkbook.ActiveSheet.Range("E8") = .Cells(3, raSpalte.Column)
ThisWorkbook.ActiveSheet.Range("E11") = .Cells(4, raSpalte.Column)
ThisWorkbook.ActiveSheet.Range("E17") = .Cells(5, raSpalte.Column)
ThisWorkbook.ActiveSheet.Range("E23") = .Cells(6, raSpalte.Column)
ThisWorkbook.ActiveSheet.Range("E26") = .Cells(7, raSpalte.Column)
ThisWorkbook.ActiveSheet.Range("E30") = .Cells(8, raSpalte.Column)
End If
End With
'Quelldatei ohne Speichern schließen
wbQuelle.Close (False)
'kein Fund - Meldung ausgeben
If Not boGefunden Then MsgBox "Die Kostenstelle " & loSuchbegriff & " wurde nicht gefunden."
'Variable aufräumen
Set wbQuelle = Nothing: Set raSpalte = Nothing
'Bildschirmaktualisierung an
Application.ScreenUpdating = True
End Sub
Gruß Werner