Sub test_1()
Dim Arr, Brr, i&, j&, T$, R&, C%
Range("a13:g2000").ClearContents
Arr = [n13].CurrentRegion
ReDim Brr(1 To 2000, 1 To 7)
For j = 1 To UBound(Arr, 2)
For i = 1 To UBound(Arr)
T = Arr(i, j): If T = "" Then GoTo i01
C = C + 1: Brr(R + 1, C) = T
If C = 7 Then C = 0: R = R + 1
i01: Next i
Next j
[a13].Resize(R + 1, 7) = Brr
End Sub
Sub test()
Dim Arr, Brr(1 To 1000, 1 To 3), Crr()
Dim i&, j&, n%, s%, m%, R%
Arr = [n13].CurrentRegion '¨Ó·½¸ê®Æ1
For j = 1 To UBound(Arr, 2): For i = 1 To UBound(Arr)
If Arr(i, j) <> "" Then
If n < 7 Then n = n + 1 Else n = 1
s = s + 1: Brr(s, 1) = n
Brr(s, 2) = Arr(i, j): Brr(s, 3) = s
End If
Next i: Next j
[j13].Resize(s, 3) = Brr 'Âà¶K¨ì2
R = Int(s / 7) + 1: ReDim Crr(1 To R, 1 To 7): k = 1
For i = 1 To s
For j = 1 To 7
m = m + 1: If m > s Then GoTo 99
Crr(i, j) = Brr(m, 2)
Next
99: Next i
Range("a13").Resize(R, 7) = Crr 'Âà¶K¨ì3
End Sub