- 帖子
- 175
- 主題
- 8
- 精華
- 0
- 積分
- 207
- 點名
- 105
- 作業系統
- WIN 10
- 軟體版本
- Office 2010
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2011-6-30
- 最後登錄
- 2025-5-3
      
|
2#
發表於 2011-8-19 17:15
| 只看該作者
回復 1# jimmuLu - 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
複製代碼 |
|