title image


Smiley Re: Schleifenproblem
Hi, Alexandra!

Ich habe das Problem gelöst. Ich habe den >Wert< immer überschrieben, es musste daher immer der gleiche Suchwert kommen.

Anbei die Lösung:



Sub FilterErgebnisUebertragen()

Application.ScreenUpdating = False

Worksheets("Auswertung").Activate

Dim i As Long, j As Long, lzeile As Long, Wert As String

lzeile = Cells(Rows.Count, 1).End(xlUp).Row



Range("AD1").Select

'Wert = ActiveCell.Value -------> hier lag der Fehler!

For j = 1 To 100

Range("AD" & j).Select

Wert = ActiveCell.Value

MsgBox Wert 'dient nur zur Kontrolle!

i = 6

Do

If Wert = Val(Left$(Range("G" & i).Value, InStr(1, Range("G" & i).Value, "/"))) Then

Range("H" & i).Select

ActiveCell.Offset(0, -7).Range(Cells(1, 1), Cells(1, 8)).Select

Selection.Copy

[af1].Select

Selection.End(xlDown).Offset(1, 0).Select

ActiveSheet.Paste

End If

i = i + 1

Application.DisplayStatusBar = True

StatusLED Space(6) & "Treffer Nr. " & Wert & " wird übertragen ", i / lzeile

Loop While Range("A" & i) ""

Application.StatusBar = ""

Next j

End Sub



Ich danke Dir nochmals recht herzlich!

Alfred vulgo Johann



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: