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

在这个网站上提问的部分要求是至少自己尝试过。看到这个代码已经在这个网站的许多地方很容易获得，我认为仅仅提供帮助没有什么坏处:)

您还需要调整此代码以满足您的需求。不过，我为你做了繁重的工作。