Hi
Try this
Code:
Option Explicit
Sub kTest()
Dim k, ka(), i As Long, n As Long, c As Long, Sht As Worksheet
k = Range("a1").CurrentRegion.Value2 '<<< adjust the range
ReDim ka(1 To UBound(k, 1) * UBound(k, 2), 1 To 3)
For i = 2 To UBound(k, 1) 'skip the header row
If Len(k(i, 1)) Then
For c = 2 To UBound(k, 2) - 1 Step 2
n = n + 1
ka(n, 1) = k(i, 1)
ka(n, 2) = k(i, c)
ka(n, 3) = k(i, c + 1)
Next
End If
Next
If n Then
On Error Resume Next
Set Sht = Worksheets("Output_")
Err.Clear: On Error GoTo 0
If Sht Is Nothing Then
Worksheets.Add.Name = "Output_"
Set Sht = ActiveSheet
End If
With Sht
.Range("a1:c1") = [{"Date","Time","Value"}]
.Range("a2").Resize(n, UBound(ka, 2)).Value = ka
.Range("a2").Resize(n).NumberFormat = "yyyy/mm/dd"
.Range("b2").Resize(n).NumberFormat = "[h]:mm"
End With
End If
End Sub
Bookmarks