在列表中查找标题名称并在工作表 1 中搜索每个标题名称，一旦找到，剪切整列并移至 A 列

Question

又是我！这次我试图形成一个代码来帮助我在我的工作表 1 中排列列。基本上我想要发生的事情是这样的

1. 从“列名称”表中的列表中查找每个标题名称
2. 在“Sheet1”的整列中搜索标题名称
3. 如果找到标题名称，则使用该标题名称剪切整个列并传输/粘贴到 A 列
4. 循环到列表中的下一个标题名称，冲洗重复

例如：

1. 找到“第 1 列”（如列名表中所列）
2. 在“Sheet1”中搜索“Column 1”名称
3. 如果在“Sheet1”中找到“Column 1”名称，则将整个列剪切并转移到 A 列
4. 循环遍历名称列表中列出的下一列名称。在这种情况下，“第 2 列”直到所有名称都被使用。

我有下面的代码..是的，它还没有工作=（...任何帮助表示赞赏！

示例 2： 所以它不起作用，因为出于某种原因，每当我更改名称列表以让我们说“日期”、“描述”等以及列名称时，它都不起作用 =(

此外，如果我将其放在另一个工作表中，我似乎无法找到选择名称列表的方法。虽然对于这个问题，这不是什么大问题，但我只需要它先工作 =(

Option Explicit
Sub ArrangeColumns()

    Dim LastColumn As Long, LastRow As Long
    Dim Position As Range
    Dim HeaderName As Range, i As Long

    With ThisWorkbook.Worksheets("Sheet1")
        For Each HeaderName In Range("A2", Range("A" & Rows.Count).End(xlUp))
        i = HeaderName.Row
            LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column 'Find the last column of row 1

            Set Position = .Range(.Cells(1, 1), .Cells(1, LastColumn)).Find(i) 'Search from column 1 to last column of row 1 for the header

            If Position Is Nothing Then '<- If header does not exist throw a message box
                 MsgBox "Header was not found."
            Else 'If header does exist
                LastRow = .Cells(.Rows.Count, Position.Column).End(xlUp).Row 'Find the last row of the column that header found

                .Range(.Cells(1, Position.Column), .Cells(LastRow, Position.Column)).Cut 'Cut the column that found from row  to last row
                .Columns("A:A").Insert Shift:=xlToRight '<- Move it to column A

            End If
        Next

    End With

End Sub