Option Explicit
Sub moveFile()
Dim FSO As Object
Dim Pfad1 As String, Pfad2 As String, Ext As String
Dim TB As Worksheet, Sp As Integer, Datei As String, DName As String
Set TB = Sheets("Tabelle1")
Sp = 1
Pfad1 = "H:\Test 1\"
Pfad2 = "H:\Test 2\"
Ext = "*.pdf"
Set FSO = CreateObject("Scripting.FileSystemObject")
Datei = Dir(Pfad1 & Ext)
Do While Len(Datei) > 0
DName = Left(Datei, InStr(Datei, ".") - 1)
If WorksheetFunction.CountIf(TB.Columns(Sp), DName) > 0 Then
FSO.moveFile Pfad1 & Datei, Pfad2
End If
Datei = Dir()
Loop
End Sub