将数据汇总到主WorkBook的VBA脚本

我需要编写一个VBA脚本来循环遍历包含许多工作簿的指定目录，并将不同数量的工作表中的集合范围复制到使用新值更新的主文件中。

我对VBA相当陌生，在很多网站上search了几个小时，试图找出我做错了什么。 毕竟在StackOverflow这个时候，我想我只是提出这个问题（希望只要按一下button，一旦我的代码工作）。

我已经附上我的代码到目前为止。

它只包含从第一个工作簿中提取数据的代码，但是我无法使代码执行预期的行为。

我可以把它编译，但它没有得到新的价值。

Sub MasterRollup() Dim MyFile As String, MyFiles As String, FilePath As String Dim wbMaster As Workbook, wbTemp As Workbook Dim wsMaster As Worksheet, wsTemp As Worksheet Dim DataRange As Range, OutRange As Range Dim OutBook As Workbook, OutSheet As Worksheet Dim ctr As Integer With Application .ScreenUpdating = False .DisplayAlerts = False End With FilePath = "C:\Users\Temp" MyFiles = "C:\Users\Temp" MyFile = Dir(MyFiles) Set OutBook = Workbooks.Open("C:\Users\Temp\OutputWorkbook.xlsx") Set OutSheet = OutBook.Sheets(1) ctr = 1 Set wbMaster = OutBook Set wsMaster = OutBook.Sheets(1) If MyFile = "FileName1.xlxs" Then '~~> Open the file and set variable Set wbTemp = Workbooks.Open(FilePath & MyFile, True) Set wsTemp = wbTemp.Sheets(1) Set DataRange = wsTemp.Range("G18:S18") Set OutRange = OutSheet.Range("B5:N5") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Close the opened file wbTemp.Close False 'set to false, because opened as read-only Set wsTemp = Nothing Set wbTemp = Nothing ctr = ctr + 1 End If With Application .ScreenUpdating = True .DisplayAlerts = True End With OutBook.SaveAs End Sub 

编辑：

我试图收集我收到的一些反馈信息，并检查了发布的链接。 我试图修改我的代码，但仍然没有看到预期的行为。 代码编译，但输出工作簿中没有数据显示。 任何帮助将非常感激。 在此期间，我会继续search:)

  Sub MasterRollup() Dim MyFile As String, MyFiles As String, FilePath As String Dim wbMaster As Workbook, wbTemp As Workbook Dim wsMaster As Worksheet, wsTemp As Worksheet Dim DataRange As Range, OutRange As Range Dim OutBook As Workbook, OutSheet As Worksheet Dim ctr As Integer, myExtension As String With Application .ScreenUpdating = False .DisplayAlerts = False End With FilePath = "C:\Users\Test" MyFiles = "C:\Users\Test" myExtension = "*.xlsx" Set OutBook = Workbooks.Open("C:\Users\Test.xlsx") Set OutSheet = OutBook.Sheets(1) ctr = 1 Set wbMaster = OutBook Set wsMaster = OutBook.Sheets(1) MyFile = Dir(FilePath & myExtension) Do While MyFile <> "" If MyFile = "File 1.xlsx" Then '~~> Open the file and set variable Set wbTemp = Workbooks.Open(FilePath & MyFile, ReadOnly:=True) '~~> Sheet 1 Set wsTemp = wbTemp.Sheets(1) Set DataRange = wsTemp.Range("G18:S18") Set OutRange = OutSheet.Range("B5:N5") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Close the opened file wbTemp.Close False 'set to false, because opened as read-only Set wsTemp = Nothing Set wbTemp = Nothing ctr = ctr + 1 End If MyFile = Dir(FilePath & myExtension) If MyFile = "File 2.xlsx" Then '~~> Open the file and set variable Set wbTemp = Workbooks.Open(FilePath & MyFile, ReadOnly:=True) '~~> Sheet 1 Set wsTemp = wbTemp.Sheets(1) Set DataRange = wsTemp.Range("G17:S17") Set OutRange = OutSheet.Range("B6:N6") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Sheet 2 Set wsTemp = wbTemp.Sheets(2) Set DataRange = wsTemp.Range("G10:S10") Set OutRange = OutSheet.Range("B7:N7") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Sheet 3 Set wsTemp = wbTemp.Sheets(3) Set DataRange = wsTemp.Range("G9:S9") Set OutRange = OutSheet.Range("B8:N8") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Sheet 4 Set ws.Temp = wbTemp.Sheets(4) Set DataRange = wsTemp.Range("G9:S9") Set OutRange = OutSheet.Range("B9:N9") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Sheet 5 Set ws.Temp = wbTemp.Sheets(5) Set DataRange = wsTemp.Range("G9:S9") Set OutRange = OutSheet.Range("B10:N10") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Sheet 6 Set ws.Temp = wbTemp.Sheets(6) Set DataRange = wsTemp.Range("G9:S9") Set OutRange = OutSheet.Range("B11:N11") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Sheet 7 Set ws.Temp = wbTemp.Sheets(7) Set DataRange = wsTemp.Range("G9:S9") Set OutRange = OutSheet.Range("B12:N12") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Sheet 8 Set ws.Temp = wbTemp.Sheets(8) Set DataRange = wsTemp.Range("G9:S9") Set OutRange = OutSheet.Range("B13:N13") DataRange.Copy OutRange.PasteSpecial xlPasteValues wbTemp.Close False 'set to false, because opened as read-only Set wbTemp = Nothing Set wsTemp = Nothing ctr = ctr + 1 End If MyFile = Dir(FilePath & myExtension) If MyFile = "File 3.xlsx" Then Set wbTemp = Workbooks.Open(FilePath & MyFile, ReadOnly:=True) '~~> Sheet 1 Set wsTemp = wbTemp.Sheets(1) Set DataRange = wsTemp.Range("G22:S22") Set OutRange = OutSheet.Range("B14:N14") DataRange.Copy OutRange.PasteSpecial xlPasteValues wbTemp.Close False 'set to false, because opened as read-only Set wbTemp = Nothing Set wsTemp = Nothing ctr = ctr + 1 End If MyFile = Dir(FilePath & myExtension) If MyFile = "File 4.xlsx" Then Set wbTemp = Workbooks.Open(FilePath & MyFile, ReadOnly:=True) '~~> Sheet 1 Set wsTemp = wbTemp.Sheets(1) Set DataRange = wsTemp.Range("G22:S22") Set OutRange = OutSheet.Range("B15:N15") DataRange.Copy OutRange.PasteSpecial xlPasteValues wbTemp.Close False 'set to false, because opened as read-only Set wbTemp = Nothing Set wsTemp = Nothing ctr = ctr + 1 End If MyFile = Dir(FilePath & myExtension) If MyFile = "File 5.xlsx" Then Set wbTemp = Workbooks.Open(FilePath & MyFile, ReadOnly:=True) '~~> Sheet 1 Set wsTemp = wbTemp.Sheets(1) Set DataRange = wsTemp.Range("G22:S22") Set OutRange = OutSheet.Range("B16:N16") DataRange.Copy OutRange.PasteSpecial xlPasteValues Set wbTemp = Nothing Set wsTemp = Nothing ctr = ctr + 1 wbTemp.Close False 'set to false, because opened as read-only End If MyFile = Dir(FilePath & myExtension) If MyFile = "File 6.xlsx" Then Set wbTemp = Workbooks.Open(FilePath & MyFile, ReadOnly:=True) '~~> Sheet 1 Set wsTemp = wbTemp.Sheets(1) Set DataRange = wsTemp.Range("G22:S22") Set OutRange = OutSheet.Range("B17:N17") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Sheet 2 Set wsTemp = wbTemp.Sheets(2) Set DataRange = wsTemp.Range("G22:S22") Set OutRange = OutSheet.Range("B18:N18") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Sheet 3 Set wsTemp = wbTemp.Sheets(3) Set DataRange = wsTemp.Range("G22:S22") Set OutRange = OutSheet.Range("B19:N19") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Sheet 4 Set wsTemp = wbTemp.Sheets(4) Set DataRange = wsTemp.Range("G22:S22") Set OutRange = OutSheet.Range("B20:N20") DataRange.Copy OutRange.PasteSpecial xlPasteValues wbTemp.Close False 'set to false, because opened as read-only Set wbTemp = Nothing Set wsTemp = Nothing ctr = ctr + 1 End If MyFile = Dir(FilePath & myExtension) If MyFile = "File 7.xlsx" Then Set wbTemp = Workbooks.Open(FilePath & MyFile, ReadOnly:=True) '~~> Sheet 1 Set wsTemp = wbTemp.Sheets(1) Set DataRange = wsTemp.Range("G18:S18") Set OutRange = OutSheet.Range("B21:N21") DataRange.Copy OutRange.PasteSpecial xlPasteValues '~~> Sheet 2 Set wsTemp = wbTemp.Sheets(2) Set DataRange = wsTemp.Range("G19:S19") Set OutRange = OutSheet.Range("B22:N22") DataRange.Copy OutRange.PasteSpecial xlPasteValues wbTemp.Close False 'set to false, because opened as read-only Set wsTemp = Nothing Set wbTemp = Nothing End If Loop MsgBox ("Task Completed!") With Application .ScreenUpdating = True .DisplayAlerts = True End With OutBook.Close SaveChanges:=True Workbooks.Open ("C:\Users\Test.xlsx") End Sub 

再次感谢！