Finde Zelle und kopiere Zelle darüber
04.09.2008 09:23:34
Horst
Ich suche nach einem bestimmten Wert in einer Spalte.
Wenn dieser Wert gefunden wurde dann merke die Zelle und suche nach einem anderen Wert in der Zeile der Zelle. Kopiere diese Werte in eine neues Tabellenblatt. Gut konnte ich lösen.
Nun möchte ich zusätzlich noch die Zelle über der gefunden Zelle in der Zeile in das neue tabellenblatt an eine x-Beliebigen stelle finden.
Wie?
Der bisherige-Code:
--------------------------------------------------------------------------
Sub sucheInSpalten()
'Suche in Spalten
Dim Anzahl1 As Long, A As Long
Dim SZelle1 As Range
Dim Suchwert1 As String
Tabelle1.Activate
Suchwert1 = "31.12.1994" 'Suchbegriff
Anzahl1 = Application.WorksheetFunction.CountIf(Tabelle1.Range("A1:A10"), Suchwert1)
For A = 1 To Anzahl1
If A = 1 Then
Set SZelle1 = Tabelle1.Range("A1:A10").Find(Suchwert1)
sucheInZeile SZelle1
Else
Set SZelle1 = Tabelle1.Range("A1:A10").FindNext(SZelle1)
End If
Next A
End Sub
Sub sucheInZeile(eineZelle As Range)
Dim SZelle3 As Range
Dim Suchwert As String
Dim Anzahl1 As Long
Suchwert = "1" 'Suchbegriff
Anzahl1 = Application.WorksheetFunction.CountIf(Tabelle1.Range(eineZelle.Address, "G6"), _
Suchwert)
For A = 1 To Anzahl1
If A = 1 Then
Set SZelle3 = Tabelle1.Range(eineZelle.Address, "G6").Find(Suchwert)
SZelle3.Copy Tabelle2.Cells(3, A + 1)
Else
SZelle3.Copy Tabelle2.Cells(3, A + 1)
End If
Next A
End Sub
---------------------------------------------------
Vielen Dank
Gruß Horst