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