Converge Data From Multiple Columns To Single Column

[ayazgreat]

hi

I want to copy data (from col a to onwards) from sheet1 to sheet2 (converting in only 3 cols) ignoring cells having blank or 0 value. I am attachig here an example workbook.

Thanks in advance.

[Admin]

Hi

try

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

[Rick Rothstein]

Another macro for you to consider...

Sub RearrangeData()
  Dim Col As Long, LastRow As Long, OutRow As Long, RowCount As Long
  Dim WSdata As Worksheet, WSout As Worksheet
  Const StartRow As Long = 2
  Set WSdata = Worksheets("Sheet1")
  Set WSout = Worksheets("Sheet2")
  LastRow = WSdata.Cells(Rows.Count, "A").End(xlUp).Row
  RowCount = LastRow - StartRow + 1
  WSout.Range("A1:C1") = Array("Loc", "Total", "Reg")
  OutRow = 2
  For Col = 3 To 6  'Columns C thru F
    WSout.Cells(OutRow, "A").Resize(RowCount) = WSdata.Cells(StartRow, "A").Resize(RowCount).Value
    WSout.Cells(OutRow, "B").Resize(RowCount) = WSdata.Cells(StartRow, Col).Resize(RowCount).Value
    WSout.Cells(OutRow, "C").Resize(RowCount) = WSdata.Cells(StartRow, "B").Resize(RowCount).Value
    OutRow = OutRow + RowCount
  Next
  WSout.Columns("B").Replace 0, "", xlWhole
  On Error GoTo NoBlanks
  WSout.Columns("B").SpecialCells(xlBlanks).EntireRow.Delete
NoBlanks:
End Sub

[ayazgreat]

Thank you very much both of you, it works fine



https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA