Gruppe
Allgemein
Problem
Die Adressblöcke in Spalte A sollen in Zeilen einer neuen Tabelle aufgelistet werden.
StandardModule: basMain
Sub Aufteilen()
Dim wks As Worksheet
Dim iRowL As Integer, iRow As Integer, iRowT As Integer
Application.ScreenUpdating = False
Set wks = ActiveSheet
Worksheets.Add after:=Worksheets(Worksheets.Count)
iRowL = wks.Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 1 To iRowL
If iRow Mod 7 = 1 Then iRowT = iRowT + 1
If Not IsEmpty(wks.Cells(iRow, 1)) Then
Cells(iRowT, iRow Mod 7) = wks.Cells(iRow, 1)
End If
Next iRow
Application.ScreenUpdating = True
End Sub