COPY工作頁及檢查儲存格內容

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

樓主熱帖

infoverdad

中學生 Rank: 2

帖子: 175
主題: 8
精華: 0
積分: 207
點名: 47
作業系統: WIN 10
軟體版本: Office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-6-30
最後登錄: 2025-2-22

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章

7^#

發表於 2017-12-3 23:46 | 只看該作者

回復 1# enoch

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

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

Revised.zip (47.41 KB)

TOP

infoverdad

中學生 Rank: 2

帖子: 175
主題: 8
精華: 0
積分: 207
點名: 47
作業系統: WIN 10
軟體版本: Office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-6-30
最後登錄: 2025-2-22

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章

6^#

發表於 2011-7-15 00:28 | 只看該作者

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

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

TOP

enoch

中學生 Rank: 2

帖子: 176
主題: 98
精華: 0
積分: 279
點名: 0
作業系統: window 7
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2011-2-17
最後登錄: 2020-4-8

5^#

發表於 2011-7-14 23:29 | 只看該作者

多謝指教, 我會慢慢消化

TOP

infoverdad

中學生 Rank: 2

帖子: 175
主題: 8
精華: 0
積分: 207
點名: 47
作業系統: WIN 10
軟體版本: Office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-6-30
最後登錄: 2025-2-22

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章

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

TOP

enoch