Suchmakro - sucht, löscht, sucht
18.08.2004 20:14:42
MichiM
ich starte ein Suchmakro (in Modul1) aus einer UserForm.
Bei Auswahl eines KD-Nummer bzw. eines Namen sollen die dazugehörigen Rechnungen gesucht und im Blatt "Zwischenspeicher" kopiert werden.
Nun werden mir die Werte kopiert - aber bei einem weiterem Suchergebniss wieder überschrieben - am Ende steht also immer nur die "letzte gefundene Rechnung" im Zwischenspeicher.
---------------------------------------
Sub Rechnungsdaten_suchen()
Dim Suchkunde As String
ThisWorkbook.Sheets("Zwischenspeicher").Unprotect "meinPasswort"
Worksheets("Zwischenspeicher").Range("A26:L40").ClearContents
Suchkunde = ""
Worksheets("Zwischenspeicher").Cells(2, 1) = ufKUNDEN.TextBox70.Value
Worksheets("Zwischenspeicher").Cells(2, 2) = ufKUNDEN.TextBox71.Value
Worksheets("Zwischenspeicher").Cells(2, 3) = ufKUNDEN.tbRECHNUNG_ANSCHRIFT.Value
Worksheets("Zwischenspeicher").Cells(2, 4) = ufKUNDEN.tbRECHNUNG_PLZ.Value
Worksheets("Zwischenspeicher").Cells(2, 5) = ufKUNDEN.tbRECHNUNG_ORT.Value
Worksheets("Zwischenspeicher").Cells(2, 6) = ufKUNDEN.tbRECHNUNG_LAND.Value
Worksheets("Zwischenspeicher").Cells(2, 7) = Worksheets("Hauptmenü").Cells(1, 6)
If Not (Worksheets("Zwischenspeicher").Cells(2, 1).Value) = "" Then
Suchkunde = Worksheets("Zwischenspeicher").Cells(2, 1).Value
Auswahlsumme = Auswahlsumme + 1
End If
Select Case Auswahlsumme
Case 1
Suche1 (Suchkunde)
End Select
ThisWorkbook.Sheets("Zwischenspeicher").Protect "meinPasswort"
End Sub
---------------------------------------
Sub Suche1(Kunde As String)
Dim I As Integer
For I = 2 To Worksheets("Rechnungen").Cells(Rows.Count, 1).End(xlUp).Row
If Kunde = Worksheets("Rechnungen").Cells(I, 1).Value Then
Kopieren (I)
End If
Next
End Sub
---------------------------------------
Sub Kopieren(Zeile As Long)
ThisWorkbook.Sheets("Zwischenspeicher").Unprotect "meinPasswort"
Dim NextRow As Long
NextRow = Worksheets("Zwischenspeicher").Cells(Rows.Count, 6).End(xlUp).Row + 1
Worksheets("Zwischenspeicher").Cells(NextRow, 1) = _
Worksheets("Rechnungen").Cells(Zeile, 3)
Worksheets("Zwischenspeicher").Cells(NextRow, 2) = _
Worksheets("Rechnungen").Cells(Zeile, 4)
Worksheets("Zwischenspeicher").Cells(NextRow, 3) = _
Worksheets("Rechnungen").Cells(Zeile, 6)
Worksheets("Zwischenspeicher").Cells(NextRow, 4) = _
Worksheets("Rechnungen").Cells(Zeile, 5)
Worksheets("Zwischenspeicher").Cells(NextRow, 8) = _
Worksheets("Rechnungen").Cells(Zeile, 13)
Worksheets("Zwischenspeicher").Cells(NextRow, 10) = _
Worksheets("Rechnungen").Cells(Zeile, 14)
Worksheets("Zwischenspeicher").Cells(NextRow, 11) = _
Worksheets("Rechnungen").Cells(Zeile, 15)
Worksheets("Zwischenspeicher").Cells(NextRow, 12) = _
Worksheets("Rechnungen").Cells(Zeile, 16)
ThisWorkbook.Sheets("Zwischenspeicher").Protect "meinPasswort"
End Sub
---------------------------------------
Weiss einer, was ich hier falsch mache?
Gruss
MichiM