彰化一整天的論壇

 找回密碼
 立即註冊
查看: 493|回復: 1

合併目錄下所有的xls檔案的全部工作表不含標題列

[複製鏈接]
發表於 2017-7-10 18:28:13 | 顯示全部樓層 |閱讀模式
這是網友來信問我的程式碼,因為覺得他的程式碼可以供其他初學者學習,詢問後同意公開程式,讓其他人也可以學習。
  1. Sub 合併目錄下所有的xls檔案的全部工作表不含標題列()

  2.     Dim MyPath, MyName, AWbName
  3.    
  4.     Dim Wb As Workbook, WbN As String
  5.    
  6.     Dim G As Long
  7.    
  8.     Dim Num As Long
  9.    
  10.     Dim BOX As String
  11.    
  12.     Application.ScreenUpdating = False
  13.    
  14.     MyPath = ActiveWorkbook.Path
  15.    
  16.     MyName = Dir(MyPath & "\" & "*.xls")
  17.    
  18.     AWbName = ActiveWorkbook.Name
  19.    
  20.     titlerow = 0
  21.    
  22.     Num = 0
  23.    
  24.     Do While MyName <> ""
  25.    
  26.         If MyName <> AWbName Then
  27.         
  28.             Set Wb = Workbooks.Open(MyPath & "\" & MyName)
  29.             
  30.             Num = Num + 1
  31.             
  32.             With Workbooks(1).ActiveSheet
  33.             
  34.             titlerow = .Range("B65536").End(xlUp).Row + 1
  35.             
  36.             .Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
  37.             
  38.             For G = 1 To Sheets.Count
  39.             
  40.                 Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
  41.             
  42.             Next
  43.             .Rows(titlerow & ":" & titlerow).Delete
  44.             
  45.             WbN = WbN & Chr(13) & Wb.Name
  46.             
  47.             Wb.Close False
  48.             
  49.             End With
  50.    
  51.         End If
  52.    
  53.         MyName = Dir
  54.    
  55.     Loop
  56.    
  57.     Range("B1").Select
  58.    
  59.     Application.ScreenUpdating = True
  60.    
  61.     MsgBox "合併了" & Num & "個" & Chr(13) & WbN, vbInformation, "提示"

  62. End Sub

複製代碼

merger_all_file.xlsm

12.53 KB, 下載次數: 3

售價: 1 金錢  [記錄]

回復

使用道具 舉報

發表於 2017-7-12 08:30:24 | 顯示全部樓層
還蠻實用的
工作常用 到這種東西謝謝分享
回復 支持 反對

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  |网站地图

GMT+8, 2018-9-24 02:48 , Processed in 0.113640 second(s), 22 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表