Thân chào các Thầy, anh chị trong GPE,
Có 1 vấn đề nhờ các Thầy và anh chị giúp em với:
Em co 1 file dữ liệu (attach file), em muốn sắp xếp các sheet có cùng số Delivery Number thì nằm gần nhau, nhưng ưu tiên Main DC thì nằm trước OFW: để dễ quản lý hơn.
Em rất mong sự giúp đỡ. Cám ơn mọi người
H tải file về kiểm tra xem sao nhé ! --> cho chạy Macro
TaoSheetIndex
Code mình cài theo các bước:
B1: tạo 1 sheet
Index
B2: Tạo liên kết (
Hyperlink) với các sheet, lấy các giá trị WAREHOUSE, DeliveryNumber (có chèn 1 Macro vào Logo công ty)
B3:
Sort số liệu sheet Index với
2 điều kiện
B4:
Sắp xếp các sheet dựa vào cột
SheetName
[GPECODE=vb]
Sub TaoSheetIndex()
Dim ws As Worksheet, Answer
'tao sheet Index: 2 truong` hop.
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "Index" Then 'neu da~ co' sheet nay`
GoTo Next1_
Else
Sheets.Add.Name = "Index"
With Sheets("Index")
.Tab.Color = RGB(255, 255, 0) 'Yellow
.Move Before:=Sheets(1) 'move sheet ve dau tien
End With
GoTo Next2_
End If
Next
Next1_:
Answer = MsgBox("Xoa' toan bo so lieu sheet Index truoc khi Update Sheet Index", vbYesNo + vbQuestion)
If Answer = vbNo Then GoTo End_
'If Answer = vbYes
Sheets("Index").Cells.Clear
Next2_:
Sheets("Index").Activate
Cells.Font.Size = 11
'tao header
Range("A1", "E1").Value = Array("No.", "SHEETNAME", "WAREHOUSE", "DeliveryNumber (D14)", "A10")
Range("A2", "E2").Value = Array("1", "2", "3", "4", "5")
With Rows("1:1").Font
.Bold = True: .ColorIndex = 9: .Underline = xlUnderlineStyleSingle
End With
Application.ScreenUpdating = False
Call CreateLinksToAllSheets
Call TaoFilter_Sort2cot
Call GPE_SortSheet
Application.ScreenUpdating = True
Sheets("Index").Activate
Cells.WrapText = False: Columns.AutoFit
Range("A1").Select
MsgBox ("TaoSheetIndex xong"), vbInformation, "@_GPE_@"
End_:
End Sub
Sub CreateLinksToAllSheets()
Dim ws As Worksheet, n As Long
Sheets("Index").Range("B3").Select 'ho~ tro*. Hyperlinks
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Index" Then
ws.Shapes("Picture 1").OnAction = "gotoIndex" 'chen` Macro vao` Logo
Cells(3 + n, 1).FormulaR1C1 = "=COUNTA(R3C2:RC[1])" 'cot No.
Cells(3 + n, 2).Hyperlinks.Add Anchor:=Selection, _
Address:="", _
SubAddress:="'" & ws.Name & "'" & "!A1", _
TextToDisplay:=ws.Name
Cells(3 + n, 4) = ws.Range("D14").Value 'DeliveryNumber
Cells(3 + n, 5) = ws.Range("A10").Value
Cells(3 + n, 3) = "=TRIM(RIGHT(RC[2],LEN(RC[2])-FIND(
"",RC[2])))" 'dat sau Cells(2 + n, 5)
Cells(3 + n, 2).Offset(1, 0).Select
n = n + 1
End If
Next ws
End Sub
Sub TaoFilter_Sort2cot()
Range(Range("A65000").End(xlUp), Range("E2")).Select
Selection.AutoFilter
'sort 2 cot: Record Macro
ActiveWorkbook.Worksheets("Index").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Index").AutoFilter.Sort.SortFields.Add Key:=Range("C2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Index").AutoFilter.Sort.SortFields.Add Key:=Range("D2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Index").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub GPE_SortSheet()
Dim rng As Range
Dim vung As Range
With Sheets("Index")
Set vung = .Range(.[B65000].End(xlUp), .[B3])
End With
For Each rng In vung
Sheets(rng.Value).Move after:=Sheets(Sheets.Count)
Next
Set vung = Nothing
End Sub
Sub gotoIndex()
Sheets("Index").Select
End Sub
[/GPECODE]
Link:
https://www.mediafire.com/?htev47vtimmj5zc
