0

我正在尝试从单个文件夹位置的多个工作簿中获取一系列数据，并将所有这些信息传递到预先存在的文件上的单个工作表中。

到目前为止，我有获取文件列表的功能：

Function GetFileList(FileSpec As String) As Variant

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String

On Error GoTo NoFilesFound

FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound

Do While FileName <> ""
    FileCount = FileCount + 1
    ReDim Preserve FileArray(1 To FileCount)
    FileArray(FileCount) = FileName
    FileName = Dir()
Loop
GetFileList = FileArray
Exit Function

NoFilesFound:
    GetFileList = False
End Function

Sub ClearCosting()

Dim var As Variant
Dim loc As String
loc = "C:\Users\m.raby\Desktop\testfolder"
var = GetFileList(loc & "*.xls*")

Dim StrFile As Variant
For Each StrFile In var

    Workbooks.Open (loc & StrFile)

        sh.Activate
        On Error Resume Next
        Set uCost = Cells.Find(What:="Run rate", After:=[A1], LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        Range(Cells(uCost.Row + 1, uCost.Column - 4), Cells(uCost.Row.End(xlDown), uCost.Column + 8)).Copy
        On Error GoTo 0

Next StrFile

End Sub

我现在坚持的是数据的检索。我正在尝试获取位于文本“运行率”下方一个单元格和左侧四个单元格的信息，然后从该单元格复制到空白单元格（行中）之前的最后一个单元格，以及右侧的八列.

我想复制此信息，并将其按原样粘贴到位于我桌面上的名为“sampletest.xlsx”的工作簿中，以及每行信息中它来自的文件名。仅对第一个工作表（应该是所有工作簿中的活动工作表）完成此操作后，我希望它进入下一个工作簿，并在“sampletest.xlsx”的下一个流中附加类似信息

如何仅在第一个工作表中捕获此范围，然后捕获文件名，并将所有这些信息附加到单个工作簿，同时遍历文件夹？

4

1 回答 1

0

这不是完整的代码，但它应该对您有所帮助。

当您使用多个工作簿时，请跟踪它们。例如开始：

Dim CurrWB As Workbook
Set CurrWB = ActiveWorkbook

然后在循环中：

Dim WB As Workbook
For Each StrFile In var
  Set WB = Workbooks.Open(loc & StrFile)
  ...
  WB.Close
Next StrFile

在循环中，您可以找到要复制的区域，例如：

R1 = 1
Do While WB.Sheets("Sheet name").Cells(R, 2) <> "Starting text"
  R1 = R1 + 1
Loop

R2 = R1 + 1
Do While WB.Sheets("Sheet name").Cells(R2, 2) <> "Ending text"
  R = R + 1
Loop

For R = R1 to R2
  CurrWB.Sheets("Report").Cells(RReport, 3) = WB.Sheets("Report").Cells(R, 3)
  RReport = RReport + 1
Next R
于 2013-06-18T17:04:03.017 回答