Hi ggummo
Try this Code in the Worksheet Module
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cNo As Long
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Address = "$R$1" Then
Application.EnableEvents = False
Range(Cells(2, 18), Cells(2, 18).End(xlDown)).Clear
cNo = ActiveSheet.Rows(1).Find(Range("R1").Value, LookAt:=xlWhole).Column
Range(Cells(2, cNo), Cells(2, cNo).End(xlDown)).Copy
Range("R2").PasteSpecial
Application.CutCopyMode = False
Application.EnableEvents = True
End If
End Sub
Bookmarks