copy a column from one Worksheet to another with header name vba

Question

I am trying to copy certain columns from one Excel-Worksheet to another. But since the Columnnumber can change it would need to be done with the name of the header. The code i tried did just nothing. If anyone knows how i could get my code working or if somebody has another code that works I would really appreciate the help The Code I tried:

 Dim Dataorigin As Worksheet
 Set Dataorigin= Workbooks("Daten.xlsm").Worksheets("Selected")
 With Dataorigin
         Dim xRg As Range
         Dim xRgUni As Range
         Dim xFirstAddress As String
         Dim xStr As String
         On Error Resume Next
         xStr= "Option Number"
         Set xRg= Range("A6:BD6").Find(xStr, , xlValues, xlWhole, , , True)
         If Not xRg Is Nothing Then
                 xFirstAddress = xRg.Address
                 Do
                        Set xRg = Range("A6:BD6").FindNext(xRg)
                        If xRgUni Is Nothing Then
                               Set xRgUni=xrg
                        Else
                                 Set xRgUni= Application.Union(xRgUni, xRg)
                        End if
                 Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
          End if
          xRgUni.EntireColumn.Select
 End With
 End Sub