ich brauche wieder mal Unterstützung bei folgendem Problem:
ich habe ein code im Forum bekommen der mir einen Wert sucht und dann bestimmte zeilen in eine andere Mappe kopiert.
nun habe ich das Problem das nur die Spalten A:D in die neu Mappe kopiert werden soll.
Der Code findet aber auch nicht die letzte zeile in der Auswertung und fügt den Inhalt immer in die Zeile 2 ein.
Wer kann mir hier weiterhelfen.
Der Code:
Public Sub Auswerten_temp()
Dim lngRow As Long, lngRowDest As Long
Dim intCounter As Integer, intCopyCount As Integer
Dim varKrit As Variant, varFind As Variant
Application.ScreenUpdating = False
varKrit = Sollwerte.TextBox1.Value
If varKrit = "" Then Exit Sub
With Worksheets("Simpati-Daten").Range("D:D")
Set varFind = .Find(What:=varKrit, After:=Range("D1"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious, _
MatchCase:=True)
If Not varFind Is Nothing Then
intCounter = 1
lngRow = varFind.Row
With Worksheets("Auswert").Range("D:D")
lngRowDest = .Range("D65536").End(xlUp).Row - 1
End With
Do
If Cells(lngRow - 5 * intCounter, varFind.Column).Value = varFind Then
intCopyCount = intCopyCount + 1
Rows(lngRow - 5 * intCounter).Copy _
Destination:=Worksheets("Auswert").Range("A" & _
lngRowDest + intCopyCount)
End If
intCounter = intCounter + 1
If intCopyCount = 5 Then Exit Do
Loop Until lngRow - 5 * intCounter < 1
Else: MSGbox "Sollwert 1 """ & varKrit & """ wurde nicht gefunden"
End If
End With
Application.ScreenUpdating = True
End Sub
Danke schon mal Joerg