標題: COPY工作頁及檢查儲存格內容 [打印本頁]

---

作者: enoch    時間: 2011-7-12 22:28     標題: COPY工作頁及檢查儲存格內容

請問若果想將BOOK1.XLS 內的所有sheets COPY 到 BOOK2.XLS內
及 檢查儲存格A1 的內容由右向左數是否等於"ABC"  
應該如何寫呢, 請指教

---

作者: infoverdad    時間: 2011-7-12 22:44

我手上有一個之前寫的巨集:
將同一目錄夾下的各檔案(可多個worksheet)，匯整在同一個工作檔案中
請參考看看[attach]6988[/attach]

---

作者: enoch    時間: 2011-7-13 00:53

我沒有權限下載

---

作者: infoverdad    時間: 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

---

作者: enoch    時間: 2011-7-14 23:29

多謝指教, 我會慢慢消化

---

作者: infoverdad    時間: 2011-7-15 00:28

先建一個獨立的目錄夾
在目錄夾下任建一個檔(檔名不拘,假設為abc.xls) 按 alt+F11
將上面的程式碼複製在模組內 存檔

將欲收集的多個檔放在此目錄夾下
再打開abc.xls 跑Exx這個巨集即可

---

作者: infoverdad    時間: 2017-12-3 23:46

回復 1# enoch


    發現之前的程式只會複製第一個工作表，一直放著沒來這裡修正，請海涵。之後有爬文取得的進一步的修正如下：
　　作者：知乎用戶　連結：https://www.zhihu.com/question/20366713/answer/50817274　來源：知乎

　　改版後的程式如附件，執行後的結果就是我想要的。
　　[attach]28086[/attach]

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)