Hi Derick,

Am Thu, 22 Oct 2015 21:18:05 -0700 (PDT) schrieb
:

1,2,3,4,5,6
2,3,4,5,6,1
3,4,5,6,1,2
4,5,6,1,2,3
5,6,1,2,3,4
6,1,2,3,4,5

try:

Sub Rearrange()
Dim myCnt As Long, i As Long, n As Long
Dim varData() As Variant

myCnt = Application.CountIf(Range("B4:G4"), "<11")
Application.ScreenUpdating = False
If myCnt = 6 Then
For i = 5 To 5 - 2 + myCnt
Range(Cells(i, 2), Cells(i, 6)).Value _
= Range(Cells(i - 1, 3), Cells(i - 1, 7)).Value
Cells(i, 7) = Cells(i - 1, 2)
Next
Else
For i = 2 To 7
ReDim Preserve varData(myCnt - 1)
If Cells(4, i) < 11 Then
varData(n) = Cells(4, i)
n = n + 1
End If
Next
Range("B5").Resize(, UBound(varData) + 1) = varData
For i = 6 To 6 - 1 + UBound(varData)
Range(Cells(i, 2), Cells(i, 2 + UBound(varData))).Value _
= Range(Cells(i - 1, 3), Cells(i - 1, 2 +
UBound(varData))).Value
Cells(i, 2 + UBound(varData)) = Cells(i - 1, 2)
Next
End If
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional