Как выбрать весь столбец, если в столбцах есть совпадение текста, и перейти на определенный лист?

Question

У меня есть таблица Excel, которая каждый раз генерирует разные имена столбцов, но имеет одно и то же начальное слово.

Так, например, у меня может быть столбец с именем «Ключ», после 2–3 столбцов будут столбцы с именами как key3, key29, аналогично, у меня есть другое слово с именем value, а затем value1, value2 после некоторогостолбцы значение 6, значение 7 и т. д.

Я хочу выполнить поиск по именам столбцов в строках листа («1: 1»). Выберите и выберите весь столбец, если текст соответствует значению, которое я назначил, инаконец, скопируйте его на отдельный лист.

Пока это то, что я пробовал.

Rows("1:1").Select 'Selecting the columns row
' Finding values with name i want to look for
Selection.Find(What:="key", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate.Select

Answer 1

Код ниже даст отличное начало.Настройте любой лист, ссылку на ячейку и диапазон по мере необходимости.Также есть масса ресурсов о том, что делает каждый метод, который я использовал в случае, если что-то вам незнакомо.

With Worksheets("Sheet1")' change as needed

    Dim lastRow as Long
    lastRow = .Cells(.Rows.Count,1).End(xlUp).Row 'change column as needed

    Dim headers as Range
    Set headers = .Range("A1",.Cells(1,.Columns.Count).End(xlToLeft))

    Dim findIt as String
    findIt = "key"

    Dim cel as Range
    For each cel in headers
        If cel.Text like "*key*" Then 
            .Range(cel,.Cells(lastRow, cel.Column)).Copy worksheets("sheet2").Cells(1,cel.Column) 'change sheet and column as needed
        End if
   Next

End With

Answer 2

Option Explicit

Sub test()

    Dim cell As Range, rng As Range
    Dim SearchString As String
    Dim LastColumn As Long

    SearchString = "Test"

    With ThisWorkbook.Worksheets("Sheet1")
        Set rng = .Rows("1")

        For Each cell In rng.Cells

            If InStr(1, cell.Value, SearchString) > 0 Then

                LastColumn = ThisWorkbook.Worksheets("Sheet2").Cells(1, ThisWorkbook.Worksheets("Sheet2").Columns.Count).End(xlToLeft).Column
                .Columns(cell.Column).Copy ThisWorkbook.Worksheets("Sheet2").Columns(LastColumn + 1)
            End If

        Next

    End With

End Sub