此程式碼只提取一個單元格內容,

Sub 批次提取字元()Dim myFile, lj, r, c, nr = 2 "指定提取單元格行c = 2 "指定提取單元格列n = 0 book1 = ActiveWorkbook.NameSet objShell = CreateObject("Shell.Application")Set objFolder = objShell.BrowseForFolder(0, "選擇資料夾", 0, 0)If objFolder Is Nothing Then MsgBox "未選擇資料夾" Exit SubEnd Iflj = objFolder.self.PathIf Right(lj, 1) <> "\" Then lj = lj & "\"End IfSet objFolder = NothingSet objShell = NothingmyFile = Dir(lj & "*.xls")While myFile <> "" Workbooks.Open lj & myFile n = n + 1 Workbooks(book1).Sheets(1).Cells(n, 1).Value = ActiveWorkbook.Sheets("資訊表").Cells(r, c).Value "提取指定單元格字元,欲提取多個自行增加程式碼 ActiveWorkbook.Close 1 myFile = DirWendEnd Sub