VBA从文件的文件夹复制信息并将信息编译为单个工作簿

Question

我试图从一个文件夹位置中的多个工作簿中获取一系列数据，并将所有信息都过滤到预先存储的单个工作表中，现有文件。

到目前为止，我有函数来获取文件的列表：

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 

什么，我停留在现在是数据的检索。我正在尝试获取位于文本“Run rate”下方一个单元格和四个文本的信息，并从该单元格复制到空白单元格之前的最后一个单元格（在该行中）以及右侧八列。

我想复制这些信息，并将其粘贴到我的桌面上名为“sampletest.xlsx”的工作簿中，以及它在每行信息中的文件名。在完成了FIRST工作表（应该是所有工作簿中的活动工作表）之后，我想让它进入下一个工作簿，并在“sampletest.xlsx”的下一个ow中附加类似信息。

我怎样才能捕获这个范围只为第一个工作表，然后捕获文件名，并将所有这些信息附加到单个工作簿，而循环一个文件夹？

Answer 1

这不是完整的代码，但它应该帮助你。

当你有多个工作簿时跟踪它们。例如开始：

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