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 

另外一部分询问这个网站的问题是具有至少尝试过自己。看到这个代码已经在这个网站的许多地方已经很容易获得，我看到没有伤害只是有帮助:)

你也需要调整此代码以满足您的需求。尽管如此，我为你做了很大的努力。