AW: Datenübertragung bei nach Filtern mit Button
29.10.2008 10:01:00
fcs
Hallo Merle,
in deinem Makro ist Bereich in dem die Sichtbaren Zellen in Spalte C gezählt werden nicht identisch mit den Zeilen deiner Datenliste, die per Filter ausgeblendet werden. Deshalb funktioniert es nicht.
Ich hab dein Makro mal etwas angepasst, so dass die Zeile ermittelt wird an der die Filterliste endet.
Gruß
Franz
Option Explicit
Sub Spediteur_Daten()
Dim Bereich As Range
Dim BereichVisible As Range
Dim SuchBereich As Range
Dim lngZeile As Long
Dim A As Long
'LetzteDaten Zeile oberhalb "Empfänger:" suchen"
lngZeile = Cells(Rows.Count, 2).End(xlUp).Row
Do Until Cells(lngZeile, 2) = "Empfänger:"
lngZeile = lngZeile - 1
Loop
lngZeile = lngZeile - 2
'sichtbare Zellen im Listenbereich
Set BereichVisible = Range(Cells(26, 3), Cells(lngZeile, 3)).SpecialCells(xlCellTypeVisible)
Set SuchBereich = Sheets("Spediteur").Range("A5:A1000")
If BereichVisible.Count 1 Then Exit Sub
For Each Bereich In Union(Range("C3"), Range("C5"), Range("C8"), Range("E16"), Range("E18"), _
Range("E19"), Range("E20"), Range("D22"), Range("D23"))
A = A + 1
Bereich = Spediteur(BereichVisible.Value, SuchBereich, A)
Next Bereich
End Sub
Function Spediteur(strWert As String, SuchBereich As Range, SaltenVerweis As Long) As String
Dim ErgZelle As Range
Set ErgZelle = SuchBereich.Find(What:=strWert, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If ErgZelle Is Nothing Then
Spediteur = ""
Else
Spediteur = ErgZelle.Offset(0, SaltenVerweis)
End If
End Function