VBA : Export Data From 1 lines to multiple rows

[Susanto3311]

hi all.
how to export to be list of my department like this:
1. my data in sheet1
2. i want to data can be export to sheet e.g. export in side sheet with list name (database structure)

here my attachment file

thanks in advance.
sst

[HansV]

Here you go:

Code: Select all

Sub SplitData()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim v() As String
    Dim i As Long
    Dim w() As String
    Application.ScreenUpdating = False
    Set ws = Worksheets("Sheet1")
    v = Split(ws.Range("A2").Value, vbLf)
    Set wt = Worksheets("export")
    wt.Cells.Clear
    wt.Range("A1:B1").Value = Array("No.", "Department")
    For i = 0 To UBound(v)
        w = Split(v(i), " . ")
        wt.Range("A" & i + 2).Resize(1, 2).Value = w
    Next i
    wt.ListObjects.Add Source:=wt.UsedRange, XLListObjectHasHeaders:=xlYes
    wt.UsedRange.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

[Susanto3311]

thank Hans but not fully work. after run your macro the result is only 1 Department "BKN Kantor Regional XII Pekanbaru2"
i want show all department names ..like
1. BKN Kantor Regional XII Pekanbaru
2. Perwakilan BKKBN Provinsi Riau
3. Stasiun Meteorologi Kelas I SSK II
4. etc......

[HansV]

It should work - see the attached workbook (now a macro-enabled workbook).

list name extract.xlsm

[Susanto3311]

hi Hans, after use your macro-enabled workbook..it's worked well..
thank you so much!!!