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

[Hung Luong]

Cai đoạn SheetExists máy báo không được define anh ạ. em nghĩ chắc sửa 1 tý này là chạy tốt ạ. Mọi nguwoif giúp em với

 

[ndu96081631]

View attachment 178146
Cai đoạn SheetExists máy báo không được define anh ạ. em nghĩ chắc sửa 1 tý này là chạy tốt ạ. Mọi nguwoif giúp em với

Tôi đã dặn rõ ràng là toàn bộ code cho vào 1 MODULE cơ mà. Bạn có biết chèn 1 MODULE không đó? Menu Insert, chọn Module rồi copy code của tôi paste vào khung bên phải của module vừa chèn

 

[Hung Luong]

Tôi đã dặn rõ ràng là toàn bộ code cho vào 1 MODULE cơ mà. Bạn có biết chèn 1 MODULE không đó? Menu Insert, chọn Module rồi copy code của tôi paste vào khung bên phải của module vừa chèn

Sorry bác . Món này em không rõ lắm. Nhưng em làm thế này : ALT +f11--> kich đúp vào sheet 1 --> Paste code của bác vào --> ấn chạy --> Máy báo dòng này không được định nghĩa
: If Not (SheetExists(CStr(Item))) Then ---> thế là em xóa luôn dòng đó đi thì nó lại chạy được ạ.

 

[ndu96081631]

Sorry bác . Món này em không rõ lắm. Nhưng em làm thế này : ALT +f11--> kich đúp vào sheet 1 --> Paste code của bác vào --> ấn chạy --> Máy báo dòng này không được định nghĩa
: If Not (SheetExists(CStr(Item))) Then ---> thế là em xóa luôn dòng đó đi thì nó lại chạy được ạ.

Làm như tôi hướng dẫn ở trên nhé

Menu Insert, chọn Module rồi copy code của tôi paste vào khung bên phải của module vừa chèn

 

[dohungmo]

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

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:


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

Bác ơi , Em có 1 file chừng 1000 sheet . Bác cho em xin code để thay đổi tên sheet theo danh sách được không ạ ?

 

[bbz10]

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ứ:

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

Anh ơi, em có nhiều file như trường hợp này nhưng file chỉ có 1 sheet, mà em muốn đổi tên sheet của mỗi file là khác nhau, anh giúp em được không ạ ?

 

[ngoctran1611]

Anh ơi, em có nhiều file như trường hợp này nhưng file chỉ có 1 sheet, mà em muốn đổi tên sheet của mỗi file là khác nhau, anh giúp em được không ạ ?

Bạn ơi, có cách xử lý chưa heng! Cho mình xin với

 

[Maika8008]

Anh ơi, em có nhiều file như trường hợp này nhưng file chỉ có 1 sheet, mà em muốn đổi tên sheet của mỗi file là khác nhau, anh giúp em được không ạ ?

Bạn ơi, có cách xử lý chưa heng! Cho mình xin với

Các bạn cần tải file lên và nêu rõ mong muốn của mình!

Và các bạn nên đăng chủ đề mới thì sẽ được nhiều người để ý giúp hơn!