Option Explicit
Sub CopyData()
Dim wshSrc As Worksheet
Dim wshDest As Worksheet
Dim rngSrc As Range, rngDest As Range, rngDestField As Range
Dim rngSrcCol As Range
Dim rngNewData As Range
Set wshSrc = ActiveWorkbook.Worksheets(1)
Set wshDest = ActiveWorkbook.Worksheets(2)
For Each rngSrc In wshSrc.UsedRange.Rows
If rngSrc.Row > 1 Then
For Each rngDest In wshDest.UsedRange.Rows
If IsEmpty(rngDest) Then
Exit For
End If
Next
If rngDest Is Nothing Then
Set rngDest = Intersect(wshDest.UsedRange.SpecialCells(xlCellTypeLastCell).EntireRow, wshDest.UsedRange).Offset(1)
End If
If Not rngDest Is Nothing Then
For Each rngSrcCol In wshSrc.UsedRange.Columns
For Each rngDestField In wshDest.UsedRange.Columns
If rngDestField.Cells(1, 1).Value = rngSrcCol.Cells(1, 1).Value Then
Set rngNewData = Intersect(rngDestField.EntireColumn, rngDest)
rngNewData.Formula = Intersect(rngSrcCol, rngSrc).Value
Exit For
End If
Next
Next
End If
End If
Next
End Sub