Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim wb, ab As Workbook
Set ab = ThisWorkbook
If Not Intersect(Target, Range("A1:BS1")) Is Nothing Then
    Columns(Target.Column).Select
    Selection.Copy
    If IsBookOpen("result.xlsx") Then
        Workbooks("result.xlsx").Activate
        Set wb = Workbooks("result.xlsx")
        lc = wb.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
        If lc = 1 Then
            If wb.Sheets(1).Cells(1, lc).Value <> "" Then lc = lc + 1
        Else
            lc = lc + 1
        End If
        wb.Sheets(1).Cells(1, lc).Select
        ActiveSheet.Paste
    Else
        Set wb = Workbooks.Add
        wb.Activate
        lc = wb.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
        If lc = 1 Then
            If wb.Sheets(1).Cells(1, lc).Value <> "" Then lc = lc + 1
        Else
            lc = lc + 1
        End If
        wb.Sheets(1).Cells(1, lc).Select
        ActiveSheet.Paste
        wb.SaveAs ".................." ' прописать путь
    End If
End If
End Sub

Function IsBookOpen(wbName As String) As Boolean
    Dim wbBook As Workbook
    For Each wbBook In Workbooks
        If wbBook.Name <> ThisWorkbook.Name Then
            If Windows(wbBook.Name).Visible Then
                If wbBook.Name = wbName Then IsBookOpen = True: Exit For
            End If
        End If
    Next wbBook
End Function