AW: Gefundene Tab1 Inhalte nach Tab2 listen
06.10.2014 20:26:47
Christian
Hallo mehmet
du musst die Variable "UntenDran" vor der For-Schleife auf 1 setzen und innhalb der For-Schleife (direkt vor dem Next) um 1 erhöhen (UntenDran = UntenDran + 1)
etwas kompakter könnte man das zB auch so schreiben:
Option Explicit
Sub TestIt()
Dim wksDst As Worksheet
Dim i As Long, k As Long
Set wksDst = ThisWorkbook.Sheets("Tabelle2")
wksDst.Cells.ClearContents
k = 1
With ThisWorkbook.Sheets("Tabelle1")
For i = 1 To .Cells(.Rows.Count, 3).End(xlUp).Row
If .Cells(i, 3) = "Buch" And _
.Cells(i + 1, 3) = "Titel" And _
.Cells(i + 2, 3) = "Author" And _
.Cells(i + 3, 3) = "Ausgabe" And _
.Cells(i + 4, 3) = "Ausleihe" And _
.Cells(i + 5, 3) = "Name" Then
wksDst.Cells(k, 1) = .Cells(i, 3).Value ' Buch
wksDst.Cells(k, 2).Resize(, 3) = .Cells(i + 1, 3).Resize(, 3).Value ' Titel
wksDst.Cells(k, 5).Resize(, 3) = .Cells(i + 2, 3).Resize(, 3).Value ' Author
wksDst.Cells(k, 8).Resize(, 3) = .Cells(i + 3, 3).Resize(, 3).Value ' Ausgabe
wksDst.Cells(k, 11).Resize(, 3) = .Cells(i + 4, 3).Resize(, 3).Value ' Ausleihe
wksDst.Cells(k, 14).Resize(, 3) = .Cells(i + 5, 3).Resize(, 3).Value ' Name
i = i + 5
k = k + 1
End If
Next
End With
Set wksDst = Nothing
End Sub
Gruß
Christian