Option Explicit
Sub test()
Dim c As Range
Dim wsZiel As Worksheet
Dim lngZiel1 As Long
Dim lngZiel2 As Long
Dim i As Long
Dim intBlatt As Integer
Dim intSpalte As Integer
Dim wsSuche As Worksheet
Dim strSuche As String
Set wsSuche = Worksheets("ws_start")
Set wsZiel = Worksheets("ws_zusammen")
lngZiel1 = 2
lngZiel2 = 2
For intBlatt = 1 To 3
With Sheets("ws_" & intBlatt & "")
If intBlatt = 1 Then
intSpalte = 4
Else
intSpalte = 6
End If
For i = 1 To .Cells(.Rows.Count, intSpalte).End(xlUp).Row
strSuche = .Cells(i, intSpalte).Value
Set c = wsSuche.Columns(4).Find(strSuche, _
LookIn:=xlValues, _
lookat:=xlWhole)
If Not c Is Nothing Then
wsZiel.Cells(lngZiel1, 1).Value = Sheets("ws_" & intBlatt & "").Name
wsZiel.Cells(lngZiel1, 2).Value = .Cells(i, intSpalte).Value
lngZiel1 = lngZiel1 + 1
Else
wsZiel.Cells(lngZiel2, 4).Value = Sheets("ws_" & intBlatt & "").Name
wsZiel.Cells(lngZiel2, 5).Value = .Cells(i, intSpalte).Value
lngZiel2 = lngZiel2 + 1
End If
Next
End With
Next
End Sub