将许多excel文件中的数据全部提取到另一个文件中？答案

【问题标题】：Pulling data from many excel files all into another file?将许多excel文件中的数据全部提取到另一个文件中？
【发布时间】：2016-07-21 19:26:35
【问题描述】：

我在这里查看了很多关于将数据从 excel 文件中提取到另一个文件中的问题，但我似乎无法弄清楚。我认为这可能与使用 Dir 定义文件有关，因为当我检查文件的值时它什么也不返回。

Sub PullFromRunsheets()


Application.EnableEvents = False
Application.ScreenUpdating = False


Dim MyObj As Object, MySource As Object, file As Variant, a As String, columnItertor As Integer

file = Dir("c:\Desktop\Runsheets\")
While (file <> "")
columnIterator = 0
  If InStr(file, "Runsheet") > 0 Then ''If the string "Runsheet" appears at least once in the filename...
     '' What to do if the file found contains the string "Runsheet"?            MsgBox "found " & file
     '' Take the value in cell B7 of the runsheet file and put it in cell A5 of the current file.
     For rowIterator = 0 To 7

            a = Workbooks(file).Worksheets("Pacman Runsheet").Cells(7, 2 + rowIterator).Value '' Set "a" = whatever value is in B7, and iterate through that row
            ActiveWorkbook.Worksheets(Sheet1).Cells(5 + rowIterator, 1).Value = a ''take that value and put it in this column, iterate through.

     Next rowIterator

     Exit Sub




  End If
  '' columnIterator = columnIterator + 1 (ignore this for now)

 file = Dir
Wend

End Sub

我实际上是在尝试从文件名中包含“Runsheet”的给定文件夹中的每个文件中提取数据，并将该数据放入写入宏的当前工作簿中。当我运行代码时，我得到没有错误，但是什么也没有发生，这就是为什么我不知道我哪里出错了。

谢谢！

【问题讨论】：

Exit Sub 删除它。当您第一次找到*Runsheet* 文件时，您将退出 proc。始终使用F8 进行调试。
确实，删除 Exit Sub
@cyboashu 我删除了它，但是我仍在努力让代码在运行时实际执行任何操作。

标签： excel vba while-loop

【解决方案1】：

玩得开心；）

Sub PullFromRunsheets()

Application.EnableEvents = False
Application.ScreenUpdating = False

Dim currentFile As Variant, baseDirectory, filterKeyword, sourceWorksheetName, sourceRange, targetWorksheetName As String, targetStartRow, targetColumnIterator As Integer

baseDirectory = "c:\Desktop\Runsheets\"
filterKeyword = "Runsheet"
sourceWorksheetName = "Pacman Runsheet"
sourceRange = "B7:B14"
targetWorksheetName = "Sheet1"
targetStartRow = 5
targetColumnIterator = 1

currentFile = Dir(baseDirectory)
While (currentFile <> "")
  If InStr(currentFile, filterKeyword) > 0 Then
     Workbooks.Open baseDirectory + currentFile
        Workbooks(currentFile).Worksheets(sourceWorksheetName).Range(sourceRange).Copy
        ThisWorkbook.Worksheets(targetWorksheetName).Cells(targetStartRow, targetColumnIterator).PasteSpecial xlPasteAll
     Workbooks(currentFile).Close
     targetColumnIterator = targetColumnIterator + 1
  End If
  currentFile = Dir
Wend

End Sub

【讨论】：