Home

Seach column header, copy data & paste into new sheet PROBLEM

Mark Hamilton
Occasional Contributor

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

Related Conversations
Tabs and Dark Mode
cjc2112 in Discussions on
38 Replies
Extentions Synchronization
Deleted in Discussions on
3 Replies
flashing a white screen while open new tab
Deleted in Discussions on
14 Replies
Stable version of Edge insider browser
HotCakeX in Discussions on
35 Replies
Security Community Webinars
Valon_Kolica in Security, Privacy & Compliance on
13 Replies