Welche Schleife ist die richtige
11.10.2016 15:45:16
Florian
jetzt rächt es sich, dass ich nie richtig VBA gelernt habe :-).
Bisher bin ich mit der Suche nach Programmschnipseln und dem Anpassen immer recht gut zurechtgekommen.
Nun benötige ich aber bitte Hilfe, da alles suchen aktuell nix hilft.
Ich benötige eine Schleife, aber wie?
Im Blatt "SUCHE" sind in Spalte O ab Zeile 4 abwärts verschiedene Matnr. (immer unterschiedliche Anzahl.
Nun möchte ich gerne, dass alle Matnr. in dem Blatt "Lagerbestand" gesucht werden und dann die entsprechenden Suchergebnisse als komplette Zeile in dem Blatt "help1" ausgegeben werden.
So sieht es ohne Schleife bisher (laienhaft) aus:
Sub findeStoffe1bulk()
Sheets("SUCHE").Select
Application.ScreenUpdating = False
Dim rng As Range
Dim Matnr As Long
Dim sFirstAdress As String
Matnr = Worksheets("SUCHE").Range("O4")
Set rng = Worksheets("Lagerbestand").Range("B:B").Find(Matnr)
If rng Is Nothing Then
Else
sfirstaddress = rng.Address
Do
rng.EntireRow.Copy
Worksheets("help1").Cells(Rows.Count, "A").End(xlUp) _
.Offset(1, 0).PasteSpecial Paste:=xlPasteAll
Set rng = Worksheets("Lagerbestand").Range("B:B").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address sfirstaddress
End If
Sheets("help1").Select
Range("B1").Select
Application.ScreenUpdating = True
End Sub
Sub findeStoffe2bulk()
Sheets("SUCHE").Select
Application.ScreenUpdating = False
Dim rng As Range
Dim Matnr As Long
Dim sFirstAdress As String
Matnr = Worksheets("SUCHE").Range("O5")
Set rng = Worksheets("Lagerbestand").Range("B:B").Find(Matnr)
If rng Is Nothing Then
Else
sfirstaddress = rng.Address
Do
rng.EntireRow.Copy
Worksheets("help1").Cells(Rows.Count, "A").End(xlUp) _
.Offset(1, 0).PasteSpecial Paste:=xlPasteAll
Set rng = Worksheets("Lagerbestand").Range("B:B").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address sfirstaddress
End If
Sheets("help1").Select
Range("B1").Select
Application.ScreenUpdating = True
End Sub
Sub findeStoffe3bulk()
Sheets("SUCHE").Select
Application.ScreenUpdating = False
Dim rng As Range
Dim Matnr As Long
Dim sFirstAdress As String
Matnr = Worksheets("SUCHE").Range("O6")
Set rng = Worksheets("Lagerbestand").Range("B:B").Find(Matnr)
If rng Is Nothing Then
Else
sfirstaddress = rng.Address
Do
rng.EntireRow.Copy
Worksheets("help1").Cells(Rows.Count, "A").End(xlUp) _
.Offset(1, 0).PasteSpecial Paste:=xlPasteAll
Set rng = Worksheets("Lagerbestand").Range("B:B").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address sfirstaddress
End If
Sheets("help1").Select
Range("B1").Select
Application.ScreenUpdating = True
End Sub
etc.
Wer kann hier bitte helfen?
Vielen Dank und Grüße
Florian