VBA Copy and Transpose to merged cells

[Melimob]

Hi

This code is working but only copying 2 rows down instead of grabbing all till last data row?

I think it's to do with the offset or the columns /rows set but don't know how to solve?

Sub TransposeToMergedCells()
Dim StartCell As Range
Dim DestCell As Range


Set StartCell = Worksheets("HRG Clients ").Range("c3") 'Source sheet
Set DestCell = Worksheets("COD Mapping").Range("d1:az1") 'Destination sheet


For c = 1 To 1
For r = 1 To 25
DestCell.Offset(0, r - 1) = StartCell.Offset(r - 1, c - 1)
Next
Set DestCell = DestCell.Offset(1, 0)
Next
End Sub

Many thanks

 

[Melimob]

this is driving me crazy ;(

My source data is starting from C3 down:
abc1
abc2
abc3
abc4
abc5
abc6

The destination is starting in D1 across but needs to placed in d1, f1, h1 etc since they are merged cells.
Running my code it's showing:

abc1 abc2 abc4 abc6

It does the first 2 correctly but abc3 and abc5 is missing?

Sub TransposeToMergedCells()
Dim StartCell As Range
Dim DestCell As Range




Set StartCell = Worksheets("HRG Clients ").Range("c3") 'Source sheet
Set DestCell = Worksheets("COD Mapping").Range("d1") 'Destination sheet




For c = 1 To 1
For r = 1 To 20
DestCell.Offset(0, r - 1) = StartCell.Offset(r - 1, c - 1)
Next
Set DestCell = DestCell.Offset(0, 1)
Next
End Sub

I know this has got to be something simple but can't figure it?

many thanks