- 帖子
- 175
- 主題
- 8
- 精華
- 0
- 積分
- 207
- 點名
- 282
- 作業系統
- WIN 10
- 軟體版本
- Office 2010
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2011-6-30
- 最後登錄
- 2024-11-29
     
|
4#
發表於 2011-7-13 20:39
| 只看該作者
把code貼在下面:
Sub Exx()
'合併同一資料夾內所有Excel檔之Sheet工作表
Dim NewName As String
Dim MyBook As Workbook
Dim MyFile$, i%, k%
MyFile = Dir(ThisWorkbook.Path & "\*.xls")
Set MyBook = ThisWorkbook
i = 1
Application.ScreenUpdating = False
Do While MyFile <> ""
If MyFile <> MyBook.Name Then
With Workbooks.Open(ThisWorkbook.Path & "\" & MyFile)
For k = 1 To Sheets.Count
Sheets(k).Select
ActiveSheet.Range("a1").Select
NewName = Left(MyFile, Len(MyFile) - 4)
ActiveSheet.Copy After:=MyBook.Sheets(MyBook.Sheets.Count)
ActiveSheet.Name = NewName & "_" & k
Next k
k = 1
Application.DisplayAlerts = False
.Close
On Error Resume Next
End With
End If
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub |
|
