Den hab ich hier gefunden komm aber nicht damit zurande.Liegt aber vielleicht auch daran das ich noch nie mit Makros gearbeitet hab jedenfalls nicht wissentlich.
Sub Vergleichen()
Dim wkb As Workbook
Dim wksA As Worksheet, wksB As Worksheet, wksC As Worksheet
Dim iWks As Integer, iRow As Integer, iRowT As Integer
On Error Resume Next
For iWks = 1 To 3
Set wkb = Workbooks("BTP_04_2003_sortiert_nach_Hotels" & iWks)
Next iWks
If Err > 0 Or wkb Is Nothing Then
Beep
Err.Clear
MsgBox prompt:="Die 3 Arbeitsmappen sind nicht vorhanden!"
Exit Sub
End If
On Error GoTo 0
Set wksA = Workbooks("BTP").Worksheets(1)
Set wksB = Workbooks("Adresses").Worksheets(1)
Set wksC = Workbooks("BTPAdresses").Worksheets(1)
iRow = 1
Do Until IsEmpty(wksA.Cells(iRow, 1))
If WorksheetFunction.CountIf( _
wksB.Columns(1), _
wksA.Cells(iRow, 1).Value) = 0 Then
iRowT = iRowT + 1
wksC.Cells(iRowT, 1).Value = wksA.Cells(iRow, 1).Value
wksC.Cells(iRowT, 2).Value = wksA.Parent.Name
End If
iRow = iRow + 1
Loop
iRow = 1
Do Until IsEmpty(wksB.Cells(iRow, 1))
If WorksheetFunction.CountIf( _
wksA.Columns(1), _
wksB.Cells(iRow, 1).Value) = 0 Then
iRowT = iRowT + 1
wksC.Cells(iRowT, 1).Value = wksB.Cells(iRow, 1).Value
wksC.Cells(iRowT, 2).Value = wksB.Parent.Name
End If
iRow = iRow + 1
Loop
End Sub
Wäre klasse wenn Du da was machen könntest .
Grüssle Georg