How to duplicate a row based on column or cell value - vba

Question

I am trying to duplicate rows in excel using VBA and merge columns into one.
The VBA code below hide some columns. i need help edit my code to show all columns(copy col A through col Q).
This is how the original data looks like
This is how i would like to end up to
This is how i get using the code listed below (problem: doesnt show or copy col. B to Col P)
I would like to show all columns between A and Q. the code below hides all columns except the first and merged one(Col A and merged col on col. B).
Sub SortMacro()
Dim SourceSheet As Worksheet
Dim OutSheet As Worksheet
Set SourceSheet = ActiveSheet
Set OutSheet = Sheets.Add
With SourceSheet
Out_i = 1
For r = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
For i = 17 To 20 'or For each i in Array(17,18,20)
OutSheet.Cells(Out_i, 1) = .Cells(r, 1)
OutSheet.Cells(Out_i, 2) = .Cells(r, i)
Out_i = Out_i + 1
Next
Next
End With
End Sub
Thanks!

Answer 1

This is my interpretation of what you need. I've added a loop to copy columns A:P into each new row
Sub SortMacro()
Dim SourceSheet As Worksheet
Dim OutSheet As Worksheet
Set SourceSheet = ActiveSheet
Set OutSheet = Sheets.Add
With SourceSheet
Out_i = 1
For r = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
' Create a new row for each column entry in Q:T
For i = 17 To 20
' Check the cell isn't empty before creating a new row
If (.Cells(r, i).Value <> "") Then
' Copy columns A:P
For j = 1 To 16
OutSheet.Cells(Out_i, j) = .Cells(r, j)
Next j
' Copy the current column from Q:T
OutSheet.Cells(Out_i, 17) = .Cells(r, i)
Out_i = Out_i + 1
End If
Next i
Next r
End With
End Sub