AW: Mehrere Spalten vergleichen
20.11.2020 16:08:22
worti
Hallo Gerald,
zB. so:
Sub Suche_in_Mehreren_Blaettern()
Dim wb1 As Workbook, wb2 As Workbook
Dim rngSB1 As Range
Dim rngSB2 As Range
Dim rngSB3 As Range
Dim lngzielzeile As Long
Set wb1 = Workbooks("141696.xlsx")
Set wb2 = Workbooks("141697.xlsm")
lngzielzeile = wb2.Worksheets("Budget").Cells(Rows.Count, 8).End(xlUp).Row + 1
Set rngSB1 = wb2.Worksheets("Budget").Columns(4)
Set rngSB2 = wb2.Worksheets("Invest").Columns(4)
Set rngSB3 = wb2.Worksheets("Sachkonto").Columns(4)
Call Suche(rngSB1, lngzielzeile, wb1, wb2)
Call Suche(rngSB2, lngzielzeile, wb1, wb2)
Call Suche(rngSB3, lngzielzeile, wb1, wb2)
End Sub
Function Suche(rngBereich As Range, lngzielzeile As Long, wb1 As Workbook, wb2 As Workbook)
Dim lngZeile As Long
Dim rngC As Range
For lngZeile = 1 To wb1.Worksheets("Export").Cells(Rows.Count, 1).End(xlUp).Row
Set rngC = rngBereich.Find(wb1.Worksheets("Export").Cells(lngZeile, 1).Value)
If rngC Is Nothing Then
If Not wb1.Worksheets("Export").Cells(lngZeile, 1).Value = "Nummer" Then
wb2.Worksheets("Budget").Cells(lngzielzeile, 8).Value = wb1.Worksheets("Export"). _
Cells(lngZeile, 1).Value
lngzielzeile = lngzielzeile + 1
End If
End If
Set rngC = Nothing
Next lngZeile
End Function
Du musst die Dateinamen noch anpassen, ich habe die von deinen hochgeladenen im Makro.
Gruß Wort