Hai Fano,
Letakkan script berikut pada sebuah Module.
Public Sub Sebar()
Dim rngData As Range, rngFind As Range
Dim rngAnchor As Range, rngRes As Range
Dim lLast As Long, lRow As Long
Application.ScreenUpdating = False
Sheet1.Range("L1").Resize(, 160).EntireColumn.Delete
Set rngAnchor = Sheet1.Range("L1")
Set rngData = Sheet1.Range("a1").CurrentRegion.Resize(, 1)
Set rngFind = rngData.Resize(1, 1)
lLast = 1
Do
Set rngFind = rngData.Find(0, rngFind)
If Not rngFind Is Nothing Then
If rngFind.Row < lLast Or rngFind.Offset(1).Value < 1 Then
lLast = 0
Else
lLast = rngFind.Row
Set rngRes = rngAnchor.Offset(0,
Int(rngFind.Offset(1).Value / 2) * 8)
rngFind.Resize(6, 7).Copy
rngRes.Offset(rngRes.CurrentRegion.Rows.Count)
End If
Else
lLast = 0
End If
Loop Until lLast = 0
Application.ScreenUpdating = True
MsgBox "Done.", vbInformation, "Sebar-sebar"
End Sub
Regards.
Kid.
On Fri, Mar 2, 2012 at 08:06, Fano The Miner <[email protected]>wrote:
> **
>
>
> Dear All Be Exceler…****
>
> ** **
>
> ** **
>
> Mohon Bantuan teman-teman.****
>
> Saya punya database yang ingin saya pisahkan dari barisan data menjadi
> kelompok data berdasarkan jenis kelompok data.****
>
> Untuk lebih jelasnya, pertanyaan lengkap ada di lampiran.****
>
> Harapan saya, teman-teman bisa berikan solusi dengan “CODING MACRO”.****
>
> ** **
>
> Terima kasih****
>
> Salam.****
>
> ** **
>
> FANO TheMiner.****
>
> ** **
>
> ** **
>
>
>
