Após DADOS para Dest, substitua tudo por:
Dim i as long
Dim linha as long
Linha= wkbSource.worksheets(1).range("A1").currentregion.rows.count
For i=2 to wkbSource.worksheets(1).range.columns.count
Ultimalinha= wkbDest.worksheets(1).range("B1").currentregion.rows.count+1
wkbDest.worksheets(1).cells(ultimalinha,2).value= wkbSource.worksheets(1).cells(linha,i).value
Next
With wkbDest.worksheets(1)
.cells(1,1).value= "Quantidade A"
.cells(2,1).value= "Quantidade B"
.cells(3,1).value= "Quantidade C"
.cells(4,1).value= "Quantidade D"
.cells(5,1).value= "Quantidade E"
.cells(6,1).value= "Quantidade F"
End with
For i=1 to wkbDest.worksheets(1).range("A1").currentregion.rows.count
With wkbDest.worksheets(1)
If .cells(i,2). Value=0 then
.Range.rows(i).delete
End If
End with
Next
Application.ScreenUpdating = true
End sub