Private Const tischeKorrektPath = "C:\Tanja\Makro\KorrekteTische.xlsx"
Private Const tableNameDestination = "Tabelle1"
Private Const tableNameTischeKorrekt = "Tabelle1"
Sub ValidateTische()
Dim shSource As Worksheet
Dim shDest As Worksheet
Dim wbk As Workbook
Dim Rng As Range, RngSourceFind As Range, rngFound As Range, rngWork As Range
Set shDest = ActiveWorkbook.Worksheets(tableNameDestination)
If Dir(tischeKorrektPath) = "" Then
MsgBox "Die Datei """ & tischeKorrektPath & """ kann nicht gefunden werden.", vbCritical
Exit Sub
End If
On Error Resume Next
Set wbk = Application.Workbooks.Open(tischeKorrektPath)
If Not Err.Number = 0 Then
Err.Clear
MsgBox "Die Datei """ & tischeKorrektPath & """ kann nicht gelesen werden.", vbCritical
Exit Sub
End If
On Error GoTo 0
Set shSource = wbk.Worksheets(tableNameTischeKorrekt)
Set RngSourceFind = Intersect(shSource.Columns(1), shSource.UsedRange)
For Each Rng In Intersect(shDest.Range("BD:BD"), shDest.UsedRange)
Set rngFound = RngSourceFind.Find(What:=Rng.Value, LookIn:=xlValues, Lookat:=xlWhole)
If Rng.Row = 1 And rngFound Is Nothing Then
Rng.Worksheet.Activate
Rng.Select
MsgBox "Spalte nicht vorhanden", vbCritical
Exit For
End If
If Rng.Row > 1 And Not rngFound Is Nothing Then
Rng.Value = rngFound.Offset(ColumnOffset:=1).Value
End If
Next
wbk.Close
End Sub