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
SrcWS.Columns(srcCel.Column).Copy
TgtWS.Cells(1, c.Column).PasteSpecial
Else
newCnt = newCnt + 1
SrcWS.Columns(srcCel.Column).Copy
'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
