Kang Wira,
silahkan dicoba vba code berikut:
'======
Option Explicit
Sub TransformData()
Dim rgDataAsal As Range
With Worksheets("Sheet1")
'1. menentukan range yang akan ditransform dan jumlah record
Set rgDataAsal = .Range("A1").CurrentRegion
'2. sort data asal berdasarkan field 'relno'
rgDataAsal.Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
'3. menentukan range relno dimulai dari baris kedua
Dim rgRelNo As Range, nRecs As Long
nRecs = rgDataAsal.Rows.Count - 1
Set rgRelNo = .Range("A2").Resize(nRecs, 1)
'4. mengumpulkan nomor relno
Dim rgCell As Range 'cell relno
Dim i As Long, j As Long, nAcc As Long
Dim DataBaru() As Variant
i = -1
For Each rgCell In rgRelNo.Cells
'4.1. jika nilai relno TIDAK SAMA dengan baris sebelumnya
If rgCell.Value <> rgCell.Offset(-1, 0).Value Then
i = i + 1
ReDim Preserve DataBaru(8, i)
DataBaru(0, i) = rgCell 'norel
DataBaru(1, i) = rgCell.Offset(, 1) 'nama
DataBaru(7, i) = rgCell.Offset(, 4) 'address 1
DataBaru(8, i) = rgCell.Offset(, 5) 'address 2
'4.2. mengumpulkan banyaknya account tiap relno
nAcc = WorksheetFunction.CountIf(rgRelNo, rgCell)
For j = 0 To nAcc - 1
DataBaru(2 + j, i) = rgCell.Offset(j, 2) & " " &
rgCell.Offset(j, 3)
Next j
End If
Next
End With
'5. mencetak di sheet yang diinginkan
Dim NewRecs As Long
NewRecs = UBound(DataBaru, 2) + 1
With Worksheets("diinginkan")
'5.1. menghapus data sebelumnya jika sudah ada
.Range("A2").Resize(10000, 9).Clear
'5.2. tulis data baru
.Range("A2").Resize(NewRecs, 9) =
WorksheetFunction.Transpose(DataBaru)
.Activate
End With
End Sub'===== From: [email protected] [mailto:[email protected]] On Behalf Of WIRAnata Kemala Sent: Monday, July 01, 2013 7:38 PM To: [email protected] Subject: [belajar-excel] multiple records (rows) jadi kolom dear all, bisa minta tolong bantuannya untuk memindahkan multiple records (rows) jadi multiple kolom? untuk lebih jelasnya, saya attach yah xls nya. mohon bantuannya dalam VBA yah - sekalian newbie belajar vba :) thanks atas bimbingan dan kesabaran rekan-rekan :) salam.
Copy of multi Book1.xlsm
Description: application/vnd.ms-excel.sheet.macroenabled.12
