作者SergioLeone (穷穷)
看板Office
标题[问题] 工作表合并，不要放副档名
时间Sun Mar 5 03:30:32 2023
(若是和其他不同软体互动之问题 请记得一并填写)
软体:
版本:excel xlsx
简单描述一下状况好
我有一个资料夹
里面有二十个excel
每个excel都有五个工作表
分别是 资产 负债 权益 资产分析 负债分析
我输入以下VBA
把每个excel里面的‘’资产分析‘’
抓出来合并到一个excel
合并後的excel会有20个工作表
工作表名称以原本二十个excel的名称命名
但是後面会加上.xlsx
VBA代码：将工作簿的指定工作表合并到主工作簿中：
Sub MergeSheets2()
'Updated by Extendoffice 2019/2/20
Dim xStrPath As String
Dim xStrFName As String
Dim xWS As Worksheet
Dim xMWS As Worksheet
Dim xTWB As Workbook
Dim xStrAWBName As String
Dim xI As Integer
On Error Resume Next
xStrPath = " C:\Users\a0921\Desktop\科余\"
xStrName = "资产分析"
xArr = Split(xStrName, ",")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xTWB = ThisWorkbook
xStrFName = Dir(xStrPath & "*.xlsx")
Do While Len(xStrFName) > 0
Workbooks.Open Filename:=xStrPath & xStrFName, ReadOnly:=True
xStrAWBName = ActiveWorkbook.Name
For Each xWS In ActiveWorkbook.Sheets
For xI = 0 To UBound(xArr)
If xWS.Name = xArr(xI) Then
xWS.Copy After:=xTWB.Sheets(xTWB.Sheets.count)
Set xMWS = xTWB.Sheets(xTWB.Sheets.count)
xMWS.Name = xStrAWBName
Exit For
End If
Next xI
Next xWS
Workbooks(xStrAWBName).Close
xStrFName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
这样合并完之後
每个工作表的名称都会带有.xlsx
我还需要一个一个删除
想请问高手如何不要有.xlsx呢
拜托 愿赠特大星巴克予以解惑之人
-----
Sent from JPTT on my iPhone
--
※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 39.14.26.114 (台湾)
※ 文章网址: https://webptt.com/cn.aspx?n=bbs/Office/M.1677958234.A.A2B.html
※ 编辑: SergioLeone (39.14.26.114 台湾), 03/05/2023 03:33:33
1F：→ waiter337: xMWS.Name = replace(xStrAWBName,".xlsx","")03/05 08:46
太感谢了！ 已私
※ 编辑: SergioLeone (39.14.26.114 台湾), 03/05/2023 14:26:12