Sub aaa()
Dim d As Object, wb As Workbook, sht As Worksheet
Dim i As Integer, k, myPath As String, myFileName As String, temp As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject(\"Scripting.Dictionary\")
myPath = ThisWorkbook.Path & \"\\元数据\\\"
myFileName = Dir(myPath & \"*.xlsx\")
Do While myFileName <> \"\"
Set wb = GetObject(myPath & myFileName)
For Each sht In wb.Sheets
If Not d.exists(sht.Name) Then
d(sht.Name) = \"\"
Workbooks.Add (xlWBATWorksheet)
Sheets(1).Name = \"临时\"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & \"\\\" & sht.Name & \".xlsx\"
With ActiveWorkbook
temp = Left(wb.Name, Len(wb.Name) - 4)
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = temp
sht.Cells.Copy .Sheets(temp).Range(\"A1\")
.Sheets(\"临时\").Delete
End With
Else
With Workbooks(sht.Name & \".xlsx\")
temp = Left(wb.Name, Len(wb.Name) - 4)
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = temp
sht.Cells.Copy .Sheets(temp).Range(\"A1\")
End With
End If
Next
wb.Close False
myFileName = Dir()
Loop
k = d.keys
For i = 0 To d.Count - 1
Workbooks(k(i) & \".xlsx\").Close True
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox \"处理完毕\"
End Sub
