Jeg kan ikke få dit link til at virke ?
http://gupl.dk/ (...)mvh
finb
Hmm, det fungerer fint for mig.
Baracuda antivirus stopper vist gupl,
kan du evt vise de rå tal som txt ?
finb
Data er struktureret som vist her (kolonnerne A-Z)
ParentA 1 2 3 4
ParentB 5 6
ParentC 7 8 9 10 11 12
ParentD
ParentE 13 14
Som vist er der parents uden værdier (child).
På et andet faneblad ønsker jeg data vist i to kolonner:
ParentA 1
ParentA 2
ParentA 3
ParentA 4
ParentB 5
ParentB 6
ParentC 7
ParentC 8
ParentC 9
ParentC 10
ParentC 11
ParentC 12
ParentE 13
ParentE 14
Som det fremgår, ønsker jeg ikke, at parents uden childs vises.
Har fået løsning på anden vis.
Til info. Løsningsforslag modtaget fra Mr. Excel forum:
**********************
Option Explicit
Sub ReorgData()
' hiker95, 10/06/2012
Dim w1 As Worksheet, wR As Worksheet
Dim i As Variant, o As Variant
Dim r As Long, lr As Long, c As Long, lc As Long, n As Long, nr As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("As-is")
lr = w1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
lc = w1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
i = w1.Range(w1.Cells(1, 1), w1.Cells(lr, lc))
n = Application.CountA(w1.Range(w1.Cells(1, 2), w1.Cells(lr, lc)))
ReDim o(1 To n, 1 To 2)
nr = 0
For r = 1 To UBound(i, 1)
For c = 2 To UBound(i, 2)
If i(r, c) <> "" Then
nr = nr + 1
o(nr, 1) = i(r, 1)
o(nr, 2) = i(r, c)
End If
Next c
Next r
If Not Evaluate("ISREF(To-be!A1)") Then Worksheets.Add(After:=w1).Name = "To-be"
Set wR = Worksheets("To-be")
wR.UsedRange.Clear
wR.Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
wR.Cells.EntireColumn.AutoFit
wR.Activate
Application.ScreenUpdating = True
End Sub