copy from one sheet to another sheet based on column names

[juville]

check this attachment..and also note revised code which takes care of last row for blank cells..

new code

Option Explicit
Sub Macro1()
    Dim Rng As Range, c As Range
    Dim sCell As Range
    Dim rSize As Long
    Dim dest As Range
    Dim lDestRow As Long
    Dim i As Integer
    
    Sheets("Base Sheet").Select
    i = 0
    Set Rng = Range([D1], [D1].End(xlToRight))
    For Each c In Rng
        Set sCell = Sheets("Roster").Range("1:1").Find(What:=c.Value, LookIn:=xlValues, LookAt:=xlWhole)
        rSize = Sheets("Roster").Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Cells.Count
        If c.Offset(1, 0).Value <> "" Then
            Set dest = c.End(xlDown).Offset(1, 0)
            If i = 0 Then
            lDestRow = dest.Row
            End If
            
            If dest.Row < lDestRow Then
            Set dest = Cells(lDestRow, dest.Column)
            End If
            
            Sheets("Roster").Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Copy
            dest.Select
            ActiveSheet.Paste
        Else
            Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Copy
            Set dest = c.Offset(1, 0)
            
            If dest.Row < lDestRow Then
            Set dest = Cells(lDestRow, dest.Column)
            End If
            
            dest.Select
            ActiveSheet.Paste
        End If
        i = i + 1
    Next
End Sub

Hi there,

i would like to ask if there's blank cells on row 20, why doesn't the data populates on row 21 onwards?

Anyway to change the coding for that?