01
02
03
04
05
06
07
08
09
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 |
|
Option Explicit
Private Sub HoleDaten()
' Sub kopiert Datenblock aus geschlossener Datei
Dim sFilename As String, sPath As String, sBlatt As String
Dim WSh As Worksheet, iZeile As Long, iOutZeile As Long
Dim sBer As String
sPath = "C:\Users\volti\Documents\Excel-Tabellen\" ' Quellpfad
sFilename = "MyTest.xlsx" ' Quellmappe
sBlatt = "DB" ' Quellblatt
Set WSh = ThisWorkbook.Sheets("Tabelle1") ' Zielblatt
sBer = "A1:N1" ' Bereich
iOutZeile = 33 ' Anfangszeile
Application.ScreenUpdating = False
With GetObject(PathName:=sPath & sFilename) ' Datei öffnen im Hintergrund
With .Sheets(sBlatt)
For iZeile = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(iZeile, "B").Value = WSh.Range("B4").Value Then
WSh.Cells(iOutZeile, "A").Resize(, 14).Value = _
.Range(Replace(sBer, "1", iZeile)).Value
iOutZeile = iOutZeile + 1 ' Nächste Ausgabezeile
End If
Next iZeile
End With
.Close SaveChanges:=False ' Datei schließen
End With
Application.ScreenUpdating = True
End Sub
|