VBA將數據從工作簿移動到一個特定工作簿

Question

我有過去5年（數百工作簿）每天的銷售數據文件。

每個工作簿都有很多工作表，我只希望從每個文件的摘要表中獲取信息。

每個文件都有一個標題爲「摘要詳細」的摘要頁面： 單元格E12，E13，E14和E15中有4個數據。

我想獲取這些信息並將其轉換爲新文件中的行。 我也希望它將工作簿的名稱複製到列A中，並將數據放在它旁邊（列B-E）。

然後我想從這些工作簿中的另一個工作表中再取兩個數據，並將它們放在上述4（F，G）右邊的列中。

其他工作表被稱爲「每日詳細」。由於銷售數據每天都在變化，因此每個文件的總行數是不同的。但是兩個相關的行被標記爲「總管道」和「總閥門」（在列B中），並且數據位於兩列的J列中。

我有按年份在文件夾中組織的文件，所以「2014」。是否可以運行宏來打開文件夾內的文件，而無需手動打開每個文件？

有關如何構建宏以從每個工作簿獲取此數據的任何想法？ 謝謝！

Answer 1

尋找本網站的最低限度會降低您與此類似的東西。退房Excel的VBA文檔內容（它的一個非常有用的資源）>>的要求

Sub Theloopofloops() 

Dim wbk As Workbook 
Dim Filename As String 
Dim path As String 
Dim rCell As Range 
Dim rRng As Range 
Dim wsO As Worksheet 
Dim StartTime As Double 
Dim SecondsElapsed As Double 
Dim sheet As Worksheet 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.Calculation = xlCalculationManual 

StartTime = Timer 

path = "pathtofile(s)" & "\" 
Filename = Dir(path & "*.xl??") 
Set wsO = ThisWorkbook.Sheets("Sheet1") 

Do While Len(Filename) > 0 
    DoEvents 
    Set wbk = Workbooks.Open(path & Filename, True, True) 
     For Each sheet In ActiveWorkbook.Worksheets 
       Set rRng = sheet.Range("b1:b308") 
       For Each rCell In rRng.Cells 
       If rCell <> "" And rCell.Value <> 0 Then 
        'code to do stuff 
        'avoid stuff like .copy/.paste 
        'using stuff like "sheet.range.value = sheet.range.value instead 
       End If 
       Next rCell 
     Next 
    wbk.Close False 
    Filename = Dir 
Loop 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
Application.Calculation = xlCalculationAutomatic 

SecondsElapsed = Round(Timer - StartTime, 2) 
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation 

End Sub 

另外一部分詢問這個網站的問題是具有至少嘗試過自己。看到這個代碼已經在這個網站的許多地方已經很容易獲得，我看到沒有傷害只是有幫助:)

你也需要調整此代碼以滿足您的需求。儘管如此，我爲你做了很大的努力。