Hi
try
Code:Sub kTest() Dim k, ka(), i As Long, c As Long, n As Long With Sheet1 .UsedRange.Replace "0", vbNullString, 1 k = .Range("a1").CurrentRegion.Value2 End With ReDim ka(1 To UBound(k, 1) * UBound(k, 2), 1 To 3) For c = 3 To UBound(k, 2) For i = 2 To UBound(k, 1) If Len(k(i, c)) Then n = n + 1 ka(n, 1) = k(i, 1) ka(n, 2) = k(i, c) ka(n, 3) = k(i, 2) End If Next Next If n Then Sheet2.Range("e2").Resize(n, UBound(ka, 2)) = ka Sheet2.Range("e1").Resize(, UBound(ka, 2)) = [{"Loc","Total","Reg"}] End If End Sub




Reply With Quote
Bookmarks