求修改代码

zhanghuiyan2008

这是合并工作表，以工作表名命名标签名称，怎样把工作表标签名称中的 .XLS去掉

Sub 工作薄间工作表合并()
On Error GoTo Errhandler
Dim FileOpen, wkb As Workbook, wks As Worksheet
Dim X As Integer, Y As Long, s As String
Application.ScreenUpdating = False
With ThisWorkbook
ChDrive .Path: ChDir .Path '更改初始文件夹
FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(*.xls*),*.xls*", MultiSelect:=True, Title:="合并工作薄")
X = 1
While X <= UBound(FileOpen)
Set wkb = Workbooks.Open(FileOpen(X))
s = wkb.Name
For Each wks In wkb.Sheets '重命名工作表
wks.Name = s
Next
wkb.Sheets().Copy After:=.Sheets(.Sheets.Count)
wkb.Close False
X = X + 1
Wend
End With
Errhandler:
Application.ScreenUpdating = True
If Err <> 0 Then MsgBox Err.Description
End Sub

网海遨游

wks.Name=split(s,".")(0)

microyip

1. v = split(lcase(wkb.Name),".xls")
   
2. s=left(wkb.Name,len(wkb.Name)-4-len(v(ubound(v))))
   
3. nI=0
   
4. For Each wks In wkb.Sheets '重命名工作表
   
5. nI=nI+1
   
6. wks.Name = s & "_" & nI
   
7. Next

复制代码

zhanghuiyan2008

网海遨游 发表于 2020-2-2 16:57
wks.Name=split(s,".")(0)

搞定，谢谢