Finding and extracting populated cells in a column

Sub snb()
  For j = 0 To 2
    sn = Filter(Evaluate("transpose(IF(" & Sheets(1).UsedRange.Columns(j + 1).Address & Replace("=##,#*#,", "#", Chr(34)) & Sheets(1).UsedRange.Columns(j + 1).Address & "))"), "*", False)
    Cells(1, j + 6).Resize(UBound(sn) + 1) = Application.Transpose(sn)
  Next
End Sub