Please help me adjust this code to paste into the next blank cell

Mark Hamilton
Occasional Contributor

Hi the following code compares column headers in two sheets and then copies the data from one sheet to the other and into/under the corresponding headers. The problem I having is that when it copies over it overwrites all existing data in the destination sheet. What I would like it to do is to paste into the next available cell at the bottom of all the existing data per column.


Sub LookAtColumnHeaders()
    Dim SrcWS        As Worksheet
    Dim TgtWS        As Worksheet
    Dim SrcColHdrs   As Range
    Dim srcCel       As Range
    Dim TgtColHdrs   As Range
    Dim srcLC        As Long
    Dim tgtLC        As Long
    Dim chgCnt       As Long
    Dim newCnt       As Long
    Dim c            As Range
    chgCnt = 0
    newCnt = 0
    Set SrcWS = Sheets("sheet1")
    Set TgtWS = Sheets("sheet2")
    With SrcWS
        'srcLC = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        srcLC = .Cells(2, Columns.Count).End(xlToLeft).Column
        Set SrcColHdrs = .Range(.Cells(1, "A"), .Cells(1, srcLC))
    End With
    With TgtWS
        'tgtLC = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        tgtLC = .Cells(2, Columns.Count).End(xlToLeft).Column
        Set TgtColHdrs = .Range(.Cells(1, "A"), .Cells(1, tgtLC))
    End With
    Application.ScreenUpdating = False
    For Each srcCel In SrcColHdrs
        Set c = TgtColHdrs.Find(srcCel.Value, , xlValues, xlWhole, xlByRows, xlNext, False)
        If Not c Is Nothing Then
            chgCnt = chgCnt + 1
            TgtWS.Cells(1, c.Column).PasteSpecial
            newCnt = newCnt + 1
            'TgtWS.Cells(1, tgtLC).PasteSpecial
            TgtWS.Cells(1, tgtLC + 1).PasteSpecial
            tgtLC = tgtLC + 1
        End If
    Next srcCel
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox chgCnt & " Quarters were updated" & " and " & newCnt & " Quarters were added"
End Sub

Related Conversations
Tabs and Dark Mode
cjc2112 in Discussions on
46 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
How to Prevent Teams from Auto-Launch
chenrylee in Microsoft Teams on
29 Replies