Public Const Mappe1 = "EILER VBA.xlsm"
Public Const Mappe2 = "Kennz_K_20160930_F.csv"
Public Const CsvSht = "Kennz_K_20160930_F"
Public Const EilSht = "Tabelle1"
Public Const NAnf = "N12"
Option Explicit
Dim cSuBer As String, clz As Long
Dim rFind As Object, SuNa As String
Dim MP1 As Workbook, MP2 As Workbook
Dim CSht As Worksheet, Sp As Integer
Sub Mappe1_aktualisieren()
Dim dlz As Long, glz As Long
Dim Adr1 As String, r As Long
Dim nAdr As String, z As Long
Set MP1 = Workbooks(Mappe1)
Set MP2 = Workbooks(Mappe2)
Set CSht = MP2.Worksheets(CsvSht)
clz = CSht.Range(NAnf).End(xlDown).Row
cSuBer = CSht.Range(NAnf, "N" & clz).Address
With MP1.Worksheets(EilSht)
dlz = .Range("D1").End(xlDown).Row
glz = .Range("G1").End(xlDown).Row
.Range("C2:E" & clz).ClearContents
.Range("F2:H" & glz).ClearContents
SuNa = .Range("D1").Value
z = 2
Sp = 4
GoSub such
SuNa = .Range("G1").Value
z = 2
Sp = 7
GoSub such
Exit Sub
such:
Set rFind = CSht.Range(cSuBer).Find(What:=SuNa, LookIn:=xlValues, _
After:=Range(NAnf), LookAt:=xlWhole, MatchCase:=True)
If rFind Is Nothing Then MsgBox SuNa & " Such-Text nicht gefunden"
If Not rFind Is Nothing Then
Adr1 = rFind.Address: nAdr = Adr1
Do
r = rFind.Row
Cells(z, Sp - 1) = r
Cells(z, Sp + 0) = CSht.Cells(r, "D")
Cells(z, Sp + 1) = CSht.Cells(r, "K")
Set rFind = CSht.Range(cSuBer).FindNext(After:=Range(nAdr))
If rFind Is Nothing Then Exit Do
nAdr = rFind.Address: z = z + 1
Loop While Adr1 <> nAdr
End If
Return
End With
End Sub