AW: Daten aus anderer Arbeitsmappe auslesen
02.10.2018 16:48:47
Werner
Hallo Andreas,
hier das geänderte Makro:
Option Explicit
Public Sub Daten_holen()
Dim wbQuelle As Workbook, wsQuelle As Worksheet
Dim strPfad As String, strBlattname As String
Dim loLetzte As Long, loSuchbegriff As Long
Dim boVorhanden As Boolean
'### Deinen Pfad hier anpassen #####
strPfad = "C:\Ordner\Unterordner\UnterUnterordner\"
strBlattname = ActiveSheet.Name & " " & Right(Range("J3"), 2)
loSuchbegriff = ActiveSheet.Range("J1")
Application.ScreenUpdating = False
'Zielbereich leeren
With ActiveSheet
loLetzte = .Cells(.Rows.Count, 14).End(xlUp).Row
If loLetzte >= 4 Then
.Range(.Cells(4, 14), .Cells(loLetzte, 17)).ClearContents
End If
End With
'Datei Ausgangsrechnungen öffnen
Set wbQuelle = Workbooks.Open(strPfad & "Ausgangsrechnungen.xlsx")
With wbQuelle
'richtiges Quellblatt wählen
For Each wsQuelle In .Worksheets
If wsQuelle.Name = strBlattname Then
boVorhanden = True
'Quellblatt nach Kostenstelle filtern
With Worksheets(wsQuelle.Name)
loLetzte = .Cells(.Rows.Count, 5).End(xlUp).Row
.Range("$A$4:$T$" & loLetzte).AutoFilter Field:=5, Criteria1:=loSuchbegriff
loLetzte = .Cells(.Rows.Count, 5).End(xlUp).Row
If loLetzte """";R4;S4)"
.Range(.Cells(4, 20), .Cells(loLetzte, 20)).Copy
.Range("O4").PasteSpecial Paste:=xlPasteValues
.Range(.Cells(4, 18), .Cells(loLetzte, 20)).ClearContents
End With
'Quellblatt ohne speichern schließen
wbQuelle.Close (False)
Application.CutCopyMode = False
End With
End If
End With
Exit For
End If
Next wsQuelle
End With
If Not boVorhanden Then
MsgBox "Es ist kein Tabellenblatt " & """" & strBlattname & """" & " vorhanden."
wbQuelle.Close (False)
End If
Set wbQuelle = Nothing
Application.ScreenUpdating = True
End Sub
Gruß Werner