Giúp đổi tên nhiều sheet nhiều file excel

rname · 10/7/14

Chào các bạn. Mình có nhiều file xls, mỗi file có nhiều sheet. Giờ cần đổi tên tất cả các sheet của tất cả các file ví dụ: file 1 có 100 sheet (tên linh tinh hết) giờ phải đổi tên theo thứ tự sheet 1 thành kh01, sheet 2 thành kh02,...đến sheet 100 hoặc thứ tự người lại sheet 100 thành kh01, sheet 99 thành kh02...đến sheet1 các file khác đổi tên như file 1. mong các bạn giúp đỡ. Cảm ơn.,

Có thể chọn đổi tên sheet theo thứ tự trai sang phải hay phải sang trái được không? dùng code như thế nào? vd: có 3 sheet từ trái sang phải tên là sheet1,sheet2,sheet3 giờ đổi từ trái sang phải thành kh01,kh02,kh03 còn đổi từ phải sang trái là kh03,kh02,kh01 tks.

tên sheet từ thứ tự 10 trở lên nó sẽ thành kh010,011...thay vì kh10,11. Mong bạn giúp luôn chỗ này.

vu_tuan_manh_linh · 10/7/14

Làm đoạn code này chạy chơi vậy bạn!!!

PHP:

Sub DoitenSh()
Dim Sh As Worksheet
For Each Sh In ActiveWorkbook.Worksheets
    Sh.Name = "KH" & Format(Sh.Index, "000")
Next
End Sub

rname · 11/7/14

vu_tuan_manh_linh đã viết:
Làm đoạn code này chạy chơi vậy bạn!!!

PHP:

Sub DoitenSh() Dim Sh As Worksheet For Each Sh In ActiveWorkbook.Worksheets Sh.Name = "KH" & Format(Sh.Index, "000") Next End Sub

Có thể chọn đổi tên sheet theo thứ tự trai sang phải hay phải sang trái được không? dùng code như thế nào? vd: có 3 sheet từ trái sang phải tên là sheet1,sheet2,sheet3 giờ đổi từ trái sang phải thành kh01,kh02,kh03 còn đổi từ phải sang trái là kh03,kh02,kh01 tks.

be_09 · 11/7/14

rname đã viết:
Có thể chọn đổi tên sheet theo thứ tự trai sang phải hay phải sang trái được không? dùng code như thế nào? vd: có 3 sheet từ trái sang phải tên là sheet1,sheet2,sheet3 giờ đổi từ trái sang phải thành kh01,kh02,kh03 còn đổi từ phải sang trái là kh03,kh02,kh01 tks.

Hoàn toàn được chứ sao không, có thể Sort theo thứ tự từ nhỏ đến lớn hoặc từ lớn đến nhỏ. Bạn thử sử dụng code trong Module.

PHP:

Sub Sort_ThuTu()
Dim i As Integer
Dim j As Integer
Dim a As Integer, b As Integer, Sn1 As String, Sn2 As String
Dim iAnswer As VbMsgBoxResult
Dim c As String

iAnswer = MsgBox("Click Yes SAP XEP SHEET THEO THU TU TANG DAN?" & Chr(10)_
       & "Click No SAP XEP SHEET THEO THU TU GIAM DAN", _
       vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")   

  For i = 1 To Sheets.Count      
  For j = 1 To Sheets.Count - 1
     If iAnswer = vbYes Then            
        Sn1 = "": Sn2 = ""            
        For a = 1 To Len(Sheets(j).Name)            
     If VBA.IsNumeric(Mid(Sheets(j).Name, a, 1)) Then            
        Sn1 = Sn1 & Mid(Sheets(j).Name, a, 1)            
        End If            
        Next a
           
  For b = 1 To Len(Sheets(j + 1).Name)            
     If VBA.IsNumeric(Mid(Sheets(j + 1).Name, b, 1)) Then            
        Sn2 = Sn2 & Mid(Sheets(j + 1).Name, b, 1)            
        End If            
        Next b
     If a <> 0 Then            
     If Val(Sn1) > Val(Sn2) Then               
        Sheets(j).Move After:=Sheets(j + 1)            
     End If            
     Else            
     If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then               
        Sheets(j).Move After:=Sheets(j + 1)            
     End If            
     End If
     ElseIf iAnswer = vbNo Then                        
        Sn1 = "": Sn2 = ""           
  For a = 1 To Len(Sheets(j).Name)            
     If VBA.IsNumeric(Mid(Sheets(j).Name, a, 1)) Then            
     Sn1 = Sn1 & Mid(Sheets(j).Name, a, 1)            
     End If            
     Next a
  For b = 1 To Len(Sheets(j + 1).Name)            
     If VBA.IsNumeric(Mid(Sheets(j + 1).Name, b, 1)) Then            
     Sn2 = Sn2 & Mid(Sheets(j + 1).Name, b, 1)            
     End If            
     Next b
     If a <> 0 Then            
     If Val(Sn1) < Val(Sn2) Then               
        Sheets(j).Move After:=Sheets(j + 1)            
     End If            
     Else            
     If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then               
        Sheets(j).Move After:=Sheets(j + 1)            
     End If                           
     End If      
     Next j   
     Next i
End Sub

be_09 · 11/7/14

Sáng đọc bài chập chờn câu cú nên trả lời không chính xác, nên xin lỗi các bạn, mong các bạn thông cãm.

Lỡ viết bài rồi rồi nên tôi để luôn để các bạn có thể sử dụng vào việc sort sheet theo thứ tự tăng dần hoặc giảm dần.

SA_DQ · 11/7/14

Để bạn tham khảo cho vui

PHP:

Option Explicit
Sub DoitenSh()
Dim Sh As Worksheet, Ch As String, KT As String
Dim J As Long, Max_ As Byte, Min_ As Byte, Num As Byte, Mu As Byte, Tmp As Byte
Num = Worksheets.Count
Ch = InputBox("Tang Hay Giam", "Dè Nghi Hay Chon Huóng", "T")
If UCase(Left(Ch, 1)) = "T" Then
    Min_ = 1:               Mu = 2
    Max_ = Num:             KT = "000"
Else
    Min_ = Num:             Mu = 3
    Max_ = 1:               KT = "_0"
End If
For J = Min_ To Max_ Step (-1) ^ Mu
    Tmp = Tmp + 1
    Sheets(J).Name = "KH" & Right(KT & CStr(Tmp), Mu + 1)
Next J
End Sub

rname · 11/7/14

cảm ơn các bạn
code HYen17 chạy được nhưng có 1 chút phát sinh nhỏ là với tên sheet từ thứ tự 10 trở lên nó sẽ thành kh010,011...thay vì kh10,11. Mong bạn giúp luôn chỗ này.
Code be09 thì báo lỗi syntax gì đó, mình không rành nên chịu thua.

Quang_Hải · 11/7/14

rname đã viết:
Chào các bạn. Mình có nhiều file xls, mỗi file có nhiều sheet. Giờ cần đổi tên tất cả các sheet của tất cả các file ví dụ: file 1 có 100 sheet (tên linh tinh hết) giờ phải đổi tên theo thứ tự sheet 1 thành kh01, sheet 2 thành kh02,...đến sheet 100 hoặc thứ tự người lại sheet 100 thành kh01, sheet 99 thành kh02...đến sheet1 các file khác đổi tên như file 1. mong các bạn giúp đỡ. Cảm ơn.,

Thử code này

PHP:

Sub ReNameSheet()
Dim WS As Worksheet, Order, i, Temp, Newsh
Order = MsgBox("From Right To Left?", vbYesNo)
With CreateObject("System.Collections.ArrayList")
   For Each WS In ThisWorkbook.Worksheets
      .Add WS.Name
   Next
   .Sort
   If Order = vbYes Then .Reverse
   Temp = .ToArray
   For i = 0 To UBound(Temp)
      Newsh = Right("000" & i + 1, Len(i) + 1)
      Sheets(Temp(i)).Name = "KH" & Newsh
   Next
End With
End Sub

sealand · 11/7/14

Mình đọc các bài và có 1 thắc mắc:Chủ topic nêu là có rất nhiều file cần đổi tên WorkSheet nhưng các bài trả lời chỉ có 1 file nhung chả ai có ý kiến, kể cả chủ Topic

Mình thấy Code như sau mới có thể chứ:

Mã:

Sub ReNameWSheet()
On Error Resume Next
Dim OpFile As Variant, Sh As Worksheet, Wb As Workbook, k
OpFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls", MultiSelect:=True)
If TypeName(OpFile) = "Boolean" Then
Exit Sub
Else
For k = 1 To UBound(OpFile)
Set Wb = Application.Workbooks.Open(OpFile(k))
For Each Sh In Wb.Worksheets
Sh.Name = "Kh" & Format(Sh.Index, "000")
Next
Wb.Save
Wb.Close
Next
End If
End Sub

rname · 11/7/14

Lúc chạy báo lỗi activex [r dòng mình tô đỏ dòng này With CreateObject("System.Collections.ArrayList")

quanghai1969 đã viết:

Thử code này

PHP:

 Sub ReNameSheet() Dim WS As Worksheet, Order, i, Temp, Newsh Order = MsgBox("From Right To Left?", vbYesNo) With CreateObject("System.Collections.ArrayList")    For Each WS In ThisWorkbook.Worksheets       .Add WS.Name    Next    .Sort    If Order = vbYes Then .Reverse    Temp = .ToArray    For i = 0 To UBound(Temp)       Newsh = Right("000" & i + 1, Len(i) + 1)       Sheets(Temp(i)).Name = "KH" & Newsh    Next End With End Sub

@seland: code bạn chạy tốt nhưng có 1 chút phát sinh nhỏ là với tên sheet từ thứ tự 10 trở lên nó sẽ thành kh010,011...thay vì kh10,11. Mong bạn giúp luôn chỗ này.

Quang_Hải · 11/7/14

rname đã viết:
Lúc chạy báo lỗi activex [r dòng mình tô đỏ dòng này With CreateObject("System.Collections.ArrayList) .

Thử lại code này

PHP:

Sub ReNameSheet()
Dim i As Long, NewSh As String, j, k
j = Sheets.Count
If MsgBox("From Right To Left", vbYesNo) = vbNo Then
   For i = 1 To j
      NewSh = Right("000" & i, Len(CStr(j -1)) + 1)
      Sheets(i).Name = "KH" & NewSh
   Next
Else
   For i = j To 1 Step -1
      k = k + 1
      NewSh = Right("000" & k, Len(CStr(k-1)) + 1)
      Sheets(i).Name = "KH" & NewSh
   Next
End If
End Sub

sealand · 11/7/14

@seland: code bạn chạy tốt nhưng có 1 chút phát sinh nhỏ là với tên sheet từ thứ tự 10 trở lên nó sẽ thành kh010,011...thay vì kh10,11. Mong bạn giúp luôn chỗ này.

Vì đang thắc mắc sợ mất công nên chưa viết đầy đủ, còn đầy đủ phải thế này:

Mã:

Sub ReNameWSheet()
Dim OpFile As Variant, Sh As Worksheet, Wb As Workbook, k, ByInd
On Error Resume Next
OpFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls", MultiSelect:=True)
If TypeName(OpFile) = "Boolean" Then
Exit Sub
Else
ByInd = MsgBox("Rename Worksheet by Index ?", vbYesNo)
For k = 1 To UBound(OpFile)
Set Wb = Application.Workbooks.Open(OpFile(k))
For Each Sh In Wb.Worksheets
If ByInd = 6 Then
Wb.Worksheets("Khang" & Format(Sh.Index, "#00")).Name = _
"Kh" & Format(Sh.Index, "#00") & "_TmpSh"
Sh.Name = "Kh" & Format(Sh.Index, "#00")
Else
Wb.Worksheets("Kh" & Format(Wb.Worksheets.Count - Sh.Index + 1, "#00")).Name = _
"Kh" & Format(Wb.Worksheets.Count - Sh.Index + 1, "#00") & "_TmpSh"
 Sh.Name = "Kh" & Format(Wb.Worksheets.Count - Sh.Index + 1, "#00")
 End If
Next
Wb.Save
Wb.Close
Next
Set Sh = Nothing: Set Wb = Nothing
End If
End Sub

rname · 11/7/14

báo lỗi dòng này
Sheets(i).Name = "KH" & NewSh

như hình đính kèm bạn ơi.

quanghai1969 đã viết:

Thử lại code này

PHP:

Sub ReNameSheet()
Dim i As Long, NewSh As String, j, k
j = Sheets.Count
If MsgBox("From Right To Left", vbYesNo) = vbNo Then
   For i = 1 To j
      NewSh = Right("000" & i, Len(CStr(j -1)) + 1)
      Sheets(i).Name = "KH" & NewSh
   Next
Else
   For i = j To 1 Step -1
      k = k + 1
      NewSh = Right("000" & k, Len(CStr(k-1)) + 1)
      Sheets(i).Name = "KH" & NewSh
   Next
End If
End Sub

Quang_Hải · 11/7/14

rname đã viết:
báo lỗi dòng này
Sheets(i).Name = "KH" & NewSh

như hình đính kèm bạn ơi.

Do bạn có tên sheet trước đó rồi.

PHP:

Sub ReNameSheet()
Dim i, NewSh, sh, j, k
j = Sheets.Count
For Each sh In Worksheets
   sh.Name = sh.CodeName
Next
If MsgBox("From Right To Left", vbYesNo) = vbNo Then
   For i = 1 To j
      NewSh = Right("000" & i, 2)
      Sheets(i).Name = "KH" & NewSh
   Next
Else
   For i = j To 1 Step -1
      k = k + 1
      NewSh = Right("000" & k, 2)
      Sheets(i).Name = "KH" & NewSh
   Next
End If
End Sub

rname · 11/7/14

sealand đã viết:

Vì đang thắc mắc sợ mất công nên chưa viết đầy đủ, còn đầy đủ phải thế này:

Mã:

Sub ReNameWSheet()
Dim OpFile As Variant, Sh As Worksheet, Wb As Workbook, k, ByInd
On Error Resume Next
OpFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls", MultiSelect:=True)
If TypeName(OpFile) = "Boolean" Then
Exit Sub
Else
ByInd = MsgBox("Rename Worksheet by Index ?", vbYesNo)
For k = 1 To UBound(OpFile)
Set Wb = Application.Workbooks.Open(OpFile(k))
For Each Sh In Wb.Worksheets
If ByInd = 6 Then
Wb.Worksheets("Khang" & Format(Sh.Index, "#00")).Name = _
"Kh" & Format(Sh.Index, "#00") & "_TmpSh"
Sh.Name = "Kh" & Format(Sh.Index, "#00")
Else
Wb.Worksheets("Kh" & Format(Wb.Worksheets.Count - Sh.Index + 1, "#00")).Name = _
"Kh" & Format(Wb.Worksheets.Count - Sh.Index + 1, "#00") & "_TmpSh"
 Sh.Name = "Kh" & Format(Wb.Worksheets.Count - Sh.Index + 1, "#00")
 End If
Next
Wb.Save
Wb.Close
Next
Set Sh = Nothing: Set Wb = Nothing
End If
End Sub

code chạy tốt mà có thể cho chọn đổi theo kiểu trái sang phải hoặc phải sang trái không bạn?

sealand · 11/7/14

code chạy tốt mà có thể cho chọn đổi theo kiểu trái sang phải hoặc phải sang trái không bạn?

Đúng vậy, nếu bạn đồng ý thì nó đổi tên sheet theo Index . Nếu chọn No nó sẽ đổi tên ngược lại.

Quang_Hải · 12/7/14

Viết theo kiểu bài 14 thì ép luôn không cho cãi. Muốn bị trùng tên cũng không trùng được

lieutran87 · 2/5/16

HYen17 đã viết:

PHP:

Option Explicit
Sub DoitenSh()
Dim Sh As Worksheet, Ch As String, KT As String
Dim J As Long, Max_ As Byte, Min_ As Byte, Num As Byte, Mu As Byte, Tmp As Byte
Num = Worksheets.Count
Ch = InputBox("Tang Hay Giam", "Dè Nghi Hay Chon Huóng", "T")
If UCase(Left(Ch, 1)) = "T" Then
    Min_ = 1:               Mu = 2
    Max_ = Num:             KT = "000"
Else
    Min_ = Num:             Mu = 3
    Max_ = 1:               KT = "_0"
End If
For J = Min_ To Max_ Step (-1) ^ Mu
    Tmp = Tmp + 1
    Sheets(J).Name = "KH" & Right(KT & CStr(Tmp), Mu + 1)
Next J
End Sub

Bạn ơi, mình muốn đổi trên sheet từ 501 đến 600 (50 sheet) thì như thế nào được?? giúp mình với

Hung Luong · 23/6/17

Mọi Người cho em hỏi them chút ạ . em muốn đặt ten sheet theo 1 bang danh sách thì làm thế nào ạ
VD: Ở sheet 1 :ta có B2 :B10 là Buoc1: Buoc8 . Chạy lệnh là nó tạo ra 8 sheet tên từ trái qua phải là Buoc1 tới buoc 8
Em cảm ơn .

ndu96081631 · 23/6/17

Hung Luong đã viết:
Mọi Người cho em hỏi them chút ạ . em muốn đặt ten sheet theo 1 bang danh sách thì làm thế nào ạ
VD: Ở sheet 1 :ta có B2 :B10 là Buoc1: Buoc8 . Chạy lệnh là nó tạo ra 8 sheet tên từ trái qua phải là Buoc1 tới buoc 8
Em cảm ơn .

Được chứ! Tham khảo code sau:

Mã:

Private Function SheetExists(ByVal SheetName As String) As Boolean
  On Error Resume Next
  SheetExists = Not Sheets(SheetName) Is Nothing
End Function
Private Function isValidSheetName(ByVal SheetName As String) As Boolean
  If (Len(SheetName) > 31) Or (Len(SheetName) = 0) Then Exit Function
  With CreateObject("VBScript.RegExp")
    .Pattern = "[\\:\][/?*]"
    isValidSheetName = Not .Test(SheetName)
  End With
End Function
Private Sub CreateSheet(ByVal arrSheets As Variant)
  Dim tmpArr, Item
  On Error GoTo ErrHandler
  tmpArr = arrSheets
  If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
  For Each Item In tmpArr
    If isValidSheetName(CStr(Item)) Then
      If Not (SheetExists(CStr(Item))) Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = CStr(Item)
      End If
    End If
  Next
  Exit Sub
ErrHandler: MsgBox Err.Description
End Sub
Sub Main()
  Dim wks As Worksheet
  Set wks = ActiveSheet
  CreateSheet wks.Range("B2:B10")
  wks.Activate
End Sub

Toàn bộ code trên bạn cho vào 1 module và chỉ cần chú ý Sub cuối cùng này:

Sub Main()
Dim wks As Worksheet
Set wks = ActiveSheet
CreateSheet wks.Range("B2:B10")
wks.Activate
End Sub

Chỗ màu đỏ là vùng dữ liệu nơi bạn đặt danh sách các sheets. Nếu danh sách nằm chỗ khác, cứ sửa chỗ màu đỏ cho phù hợp là được

Giúp đổi tên nhiều sheet nhiều file excel

Thành viên mới

linhvtm84@gmail.com

Thành viên mới

Biên Hòa, Đồng Nai

Biên Hòa, Đồng Nai

/(hông là gì!

Thành viên mới

Thành viên gạo cội

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên gạo cội

Thành viên mới

Thành viên mới

Huyền thoại GPE

Đếm ngược thời gian