This snippet of code searches for specific headers and then copies the date under them to another sheet. My problem is that it is pasting from Range (A3) and then right. i.e. pasting into cell A3 then B3 then B4 etc. What I need it do is paste under the same header in the other sheet and at the next blank row. Can anyone help with this please?
'ThisWorkbook.Worksheets("sheetx").Cells(1, 1).Select
Worksheets("sheet1").Activate
a = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Dim arrCols, shtSrc As Worksheet, rngDest As Range, hdr, pn
arrCols = Array("LaboratoryReference", "UniqueCode", "SerialNumber") '<< column headers to be copied
Set shtsrc=Sheets("Sheet1") '<< sheet to copy from
Set rngDest = Sheets("Sheet3").Range("A3") '<< starting point for pasting
'loop over columns
For Each hdr In arrCols
pn = Application.Match(hdr, shtSrc.Rows(1), 0)
If Not IsError(pn) Then
'##Edit here##
shtSrc.Range(shtSrc.Cells(2, pn), _
shtSrc.Cells(Rows.Count, pn).End(xlUp)).Copy rngDest
'/edit
Else
rngDest.Value = hdr
rngDest.Interior.Color = vbRed '<< flag missing column
End If
Set rngDest = rngDest.Offset(0, 1)
Next hdr
