Vba 重新排列所有图纸中的列

我在工作簿中有六张工作表，两张工作表中有40列，其他四张工作表中有44列，因此当我合并所有工作表时，值没有正确出现，因此首先我计划重新排列所有工作表中的列，因为在我的原始数据中，标题是从第11行开始的，因此在代码本身中，我删除了前10行，然后，我的标题将从第一行开始，在我下面的代码中，所有工作表中的行将被删除，但第一个工作表中的列将被重新排列，只有其他工作表列位于同一位置。任何人都可以帮我解决这个问题

提前谢谢

作为参考，请在下面找到我的代码

Sub gram_em()
Dim ws As Worksheet, xWs As Worksheet
 strFile = Application.GetOpenFilename
  Application.Workbooks.Open (strFile)

For Each ws In Sheets
 If ws.Visible Then ws.Select (False)
Next

Set xWs = ActiveSheet
Rows("1:10").Select    
Selection.Delete    
Range("A1").Select    
xWs.Select

Set xWs = ActiveSheet    
Range("A1").Select
arrColOrder = Array("BA ID", "BA Name", "Project Number", "Project 
Name", "Service Month", "Last Action Perfromed by")
counter = 1
Application.ScreenUpdating = False
For ndx = LBound(arrColOrder) To UBound(arrColOrder)
    Set Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, 
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, 
MatchCase:=False)
    If Not Found Is Nothing Then
        If Found.Column <> counter Then
            Found.EntireColumn.Cut
            Columns(counter).Insert shift:=xlToRight
            Application.CutCopyMode = False
        End If
        counter = counter + 1
    End If
Next ndx
xWs.Select
Application.ScreenUpdating = True   
End Sub

子程序
将ws设置为工作表，将xWs设置为工作表
strFile=Application.GetOpenFilename
Application.Workbooks.Open（strFile）
对于每个ws-In表单
如果ws.Visible，则ws.Select（False）
下一个
设置xWs=ActiveSheet
行（“1:10”）。选择
选择。删除
范围（“A1”）。选择
选择
设置xWs=ActiveSheet
范围（“A1”）。选择
arrColOrder=数组（“BA ID”、“BA名称”、“项目编号”、“项目
名称“，”服务月“，”执行的最后一项操作“）
计数器=1
Application.ScreenUpdating=False
对于ndx=LBound（arrColOrder）到UBound（arrColOrder）
Set Found=Rows（“1:1”）。Find（arrColOrder（ndx），LookIn:=xlValues，
LookAt:=xlother，SearchOrder:=xlByColumns，SearchDirection:=xlNext，
匹配案例：=假）
如果找不到，那就什么都没有了
如果找到，则为列计数器
发现，发现
列（计数器）。插入移位：=xlToRight
Application.CutCopyMode=False
如果结束
计数器=计数器+1
如果结束
下一个ndx
选择
Application.ScreenUpdating=True
端接头

假设您的逻辑是正确的，请尝试以下操作。它扩展了循环。请注意，您不需要选择任何内容

Sub gram_em()

Dim ws As Worksheet, wb As Workbook, Found as Range, ndx as Long, counter as Long

strFile = Application.GetOpenFilename
Set wb = Application.Workbooks.Open(strFile)
arrColOrder = Array("BA ID", "BA Name", "Project Number", "Project Name", "Service Month", "Last Action Perfromed by")

Application.ScreenUpdating = False

For Each ws In wb.Sheets
    If ws.Visible Then
        ws.Rows("1:10").Delete
        counter = 1
        For ndx = LBound(arrColOrder) To UBound(arrColOrder)
            Set found = ws.Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                                            SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                                            MatchCase:=False)
            If Not found Is Nothing Then
                If found.Column <> counter Then
                    found.EntireColumn.Cut
                    ws.Columns(counter).Insert shift:=xlToRight
                End If
                counter = counter + 1
            End If
        Next ndx
    End If
Next ws

Application.ScreenUpdating = True

End Sub

子程序
将ws作为工作表，wb作为工作簿，查找范围，ndx作为长度，计数器作为长度
strFile=Application.GetOpenFilename
设置wb=Application.Workbooks.Open（strFile）
arrColOrder=数组（“BA ID”、“BA名称”、“项目编号”、“项目名称”、“服务月份”、“执行的最后一项操作”）
Application.ScreenUpdating=False
对于wb.Sheets中的每个ws
如果ws.Visible那么
ws.Rows（“1:10”）。删除
计数器=1
对于ndx=LBound（arrColOrder）到UBound（arrColOrder）
设置Find=ws.Rows（“1:1”）.Find（arrColOrder（ndx），LookIn:=xlValues，LookAt:=xlWhole_
SearchOrder:=xlByColumns，SearchDirection:=xlNext_
匹配案例：=假）
如果找不到，那就什么都没有了
如果找到，则为列计数器
发现，发现
ws.Columns（计数器）。插入移位：=xlToRight
如果结束
计数器=计数器+1
如果结束
下一个ndx
如果结束
下一个ws
Application.ScreenUpdating=True
端接头

与第一个循环不同，在第二个循环中，您没有引用任何工作表。我没有引用任何工作表，只是在所有工作表中上载工作簿，然后它必须重新排列列。您使用“查找”来查找标题，但是除非它们在同一张表中的位置完全相同，否则你需要在各个表中循环。那么，你能告诉我如何在所有表中循环吗，因为我不知道如何在代码中以及在哪里放置循环。