Hallo Nick,

Option Explicit

Sub Nick()
Dim InI As Integer
Dim LoI As Long
Dim LoLetzte As Long
Application.ScreenUpdating = False
For InI = 1 To 50
For LoI = 1 To 2993 ' an 2994 gibt es nicht mehr 8 Zellen zum kopieren
If Cells(LoI, InI) <> "" Then
Range(Cells(LoI, InI), Cells(LoI + 7, InI)).Copy
With Worksheets("Auswertung")
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
.Cells(LoLetzte, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
LoI = LoI + 8
End If
Next LoI
Next InI
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

Gruß Hajo

Hallo Hajo,

Danke erstmal.
Eine Änderung hätte ich noch, im Quellblatt soll erst ab Spalte 2 und Zeile 7 mit der Suche begonnen werden und im Blatt "Auswertung" sollen die Werte erst ab Spalte 2 und Zeile 5 eingetragen werden

Danke
Retaster

Hallo Nick,

ändere die Variablen in der For Next schleife von 1 auf 2 und 50 auf 51 und 1 auf 7 und 2993 auf 2999.

zum zweiten vielleicht reicht
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) + 1
.Cells(LoLetzte, 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True

Gruß Hajo

Hallo Hajo,

Danke erstmal, der erste Tip funktioniert, aber im Zielblatt beginnt das makro nach wie vor in Reihe 2 statt in Reihe 5.

Gruss

Hallo Nick,

Dann schreibe was in B4 z.b. Leerstelle.

Gruß Hajo