Hallo Leute,
ich habe folgenden Code, der die untenstehende Aufgabe ausfuehren soll:
Ich habe mehrere Excel-Blaetter mit jeweils einer grossen Tabelle. Nun moechte ich auf einem extra Excel-Blatt drei Kriterien eingeben koennen in drei Zellen (z. B. Hafen1, Hafen2 und Ladung) und dann auf einen Button druecken und es wird dann in den anderen Excel-Blaettern nach Uebereinstimmungen gesucht und wenn welche gefunden werden, werden diese auf dem Excel-Blatt mit den drei Kriterien weiter unten dargestellt (allerdings nicht nur eine Zelle, sondern gleich die ganze Zeile von den jeweiligen anderen Excel-Blaettern).
Und das ist der Code:
Private Sub CommandButton1_Click()
Dim lngLetzteZeile As Long
Dim lngZeile As Long
Dim rngZelle As Range
Dim wksBlatt As Worksheet
Dim intZaehler As Integer
Dim POL
Dim POD
Dim Commodity
POL = Worksheets("Search").Range("B3")
POD = Worksheets("Search").Range("B4")
Commodity = Worksheets("Search").Range("B5")
'letzte Zeile in Blatt "Search" feststellen:
lngLetzteZeile = Worksheets("Search").Cells(Rows.Count, 1).End(xlUp).Row + 1
'alte Werte löschen:
Worksheets("Search").Range("A18:AH" & lngLetzteZeile).Clear
'alle Blätter (außer "Search") durchlaufen:
For Each wksBlatt In ThisWorkbook.Worksheets
If InStr(wksBlatt.Name, "Search") = 0 Then
'letzte Zeile in Blatt "Search" feststellen:
lngLetzteZeile = Worksheets("Search").Cells(Rows.Count, 1).End(xlUp).Row + 1
On Error Resume Next
'Wenn der Wert von POL in Spalte L gefunden wird:
If Not IsError(Application.WorksheetFunction.Match(Worksheets("Search").Range("B3"), wksBlatt.Range("L:L"), 0)) Then
lngZeile = Application.WorksheetFunction.Match(POL, wksBlatt.Range("L:L"), 0)
'Wenn der Wert von POD in Spalte M der gleichen Zeile gefunden wird:
If wksBlatt.Cells(lngZeile, 13) = POD Then
If wksBlatt.Cells(lngZeile, 14) = Commodity Then
'Den Bereich vom Blatt kopieren und in das Blatt "Search" einfügen:
wksBlatt.Range("A" & lngZeile & ":AH" & lngZeile).Copy _
Destination:=Worksheets("Search").Range("A" & lngLetzteZeile & ":AH" & lngLetzteZeile)
End If
End If
End If
End If
Next wksBlatt
End Sub
Jetzt besteht mein Problem dadrin, dass er nicht alle Blaetter durchsucht, sondern nur die letzten drei und diese auch nicht vollstaendig. Er soll alle Blaetter durchsuchen und auch mehrere Treffer anzeigen (also mehrere Zellen kopieren).
Ist das soweit verstaendlich?
Vielen Danke und liebe Gruesse
Motti
|