多張工作表欄位相同, 卻位置不同時的處理

大家好, 這個程式與大家分享 , 用於多張工作表欄位相同, 郤位置不同時的處理

大家好謝謝大家 , 這個程式可指定工作表進行工作表的整理
Sub 調整欄()
Dim a(1024)
'-------------執行時請先選定工作表----------------------------
now_index = ActiveSheet.Index
'------------讀取欄標題
i = 1
While Cells(1, i) Empty
a(i - 1) = Cells(1, i)
Cells(1, i) = i & Cells(1, i)

i = i + 1
Wend

For j = 1 To Sheets.Count
Sheets(j).Select
If ActiveSheet.Index = now_index Then
Else
For x = 0 To i - 2
Cells.Find(What:=a(x), After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
ActiveCell.Value = x + 1 & ActiveCell.Value
Next
End If

Next
'-----------依列排序--------------


For k = 1 To Sheets.Count
Sheets(k).Select
Cells(1, 1).Select
t_rng = Range(Selection, Selection.End(xlToRight)).Address
all_rng = Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Address


ActiveWorkbook.Worksheets(k).SORT.SortFields.Clear
ActiveWorkbook.Worksheets(k).SORT.SortFields.Add Key:=Range(t_rng), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(k).SORT
.SetRange Range(all_rng)
.Header = xlYes
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Next
'--------清除數字---------------
For j = 1 To Sheets.Count
Sheets(j).Select
Range(t_rng).Select
For i = 1 To 6
Selection.Replace What:=i, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next
Next
End Sub