Copying data from one worksheet to another base on the header name.

[juville]

Hi all, i have this code below to copy my data (below the header) to another worksheet with the same header.
The macro will automatically find those with the same header name and populates the data below.

however, it seems like, whenever there's a blank in that column, it stops at the cell before the blank.

Eg. Column E, it stops at row 23 as there's a blank cell at row 24. However there is still data on cell E25 onwards.

How do i resolve this?

Thank you


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
Dim lastRow As Long

' MsgBox Range("D65536").End(xlUp).Select

Sheets("Base Sheet").Select
i = 0
Set Rng = Range([D3], [D3].End(xlToRight))
For Each c In Rng
Set sCell = Sheets("Roster").Range("3: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
'c.End(xlDown).Offset(1, 0).Resize(rSize, 1) = Sheets("Roster").Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Value

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
'c.Offset(1, 0).Resize(rSize, 1).Value = Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Value
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

[Paul_Hossler]

If there's a chance of blank headers, I usually back in from the far right to the first non-blank cell

Not tested or even compiled





With Sheets("Base Sheet")

Set Rng = Range(.Cells(3,4), .Cells(.3, .Columns.Count).End (xlToLeft))
End with