excel - 循环遍历多个 excel 文件并从每个文件下载数据的宏
问题描述
该宏的目标是将来自不同月份的多个 excel 文件的数据合并到一个主 excel 文件中。我在主 excel 文件中为每个月创建了一个选项卡(见附图),我希望数据可以去往并堆叠在一起。
我发现了一些有用的代码,我不得不工作了几次,但修改后现在被破坏了。我认为在它可以像我想要的那样工作之前我需要解决的一些问题是:
此代码是使用固定范围构建的,可以复制。我正在查看的 excel 文件将具有可变的范围。
代码在读取的行上不断中断
Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True)
。这可能是因为我正在测试不同月份文件夹中所有同名的 excel 文件?
我收到以下错误:“运行时错误'1004':Microsoft Excel 无法访问文件'S:\Actg\TESTING\September\Loans_20180920.csv'。有几个可能的原因:-文件名或路径确实不存在。-该文件正被另一个程序使用”。我检查并删除了我正在测试的所有其他 excel 文件,除了九月文件夹中的文件,但我仍然收到此错误。
- 有没有办法可以修改此代码,以便我不必每个月复制 12 次?我想如果在我输入要下载的月份的地方提示一个文本框会很好。无论哪种方式...我已经复制了 12 次,所以它不会是任何额外的工作。
原始代码参考:Dan Wagner(将工作表从多个工作簿复制到当前工作簿)
这是我正在使用的代码:
Sub Stack_Overflow_Example()
Dim MyFile As String, MyFiles As String, FilePath As String
Dim erow As Long
Dim wbMaster As Workbook, wbTemp As Workbook
Dim wsMaster As Worksheet, wsTemp As Worksheet
FilePath = "S:\Actg\TESTING\September\"
MyFiles = "S:\Actg\TESTING\September\*.csv"
MyFile = Dir(MyFiles)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Set wbMaster = ThisWorkbook
Set wsMaster = wbMaster.Sheets("September")
Do While Len(MyFile) > 0
If MyFile <> "master.xlsm" Then
Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True)
Set wsTemp = wbTemp.Sheets(1)
With wsMaster
erow = .Range("A" & .Rows.Count).End(xlUp).Row
wsTemp.Range("A2:U88").Copy
.Range("A" & erow).Offset(1, 0).PasteSpecial xlPasteValues
End With
wbTemp.Close False
Set wsTemp = Nothing
Set wbTemp = Nothing
End If
MyFile = Dir
Loop
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
如果您还有其他问题,请告诉我。
解决方案
我的情况听起来与您的情况有些不同,因为我从中复制数据的每个工作簿在每个工作簿以及主工作簿中都有单独的月份,但这应该让您走上正确的道路。
请注意,下面的代码假定存在不应复制的标题行。如果没有,那么您将复制行中的第一行从 2 更改为 1。如果您需要从多个位置打开文件,您可以在文件打开代码块之前为位置数量添加另一个循环,并为循环的每次迭代更改每个位置的 MyFolder 变量。
Sub RefreshMasterWorkbookData()
'Enable Error Handling
On Error GoTo Oops
'Declare variables and objects
Dim WkBk As Workbook, WkShtMaster As Worksheet, WkShtUser As Worksheet, CopyToRow As Long, PasteAtRow As Long
'Turn off screen updating and calculation to improve process speed and turn off events to keep other code (such as Worksheet_Change) from being triggered
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Open all files in a given directory
Dim MyFolder As String, MyFile As String
MyFolder = "C:\MyFolder" 'OR: "\\NetworkServer\NetworkFolder"
MyFile = Dir(MyFolder & "\*.xlsm") '& "\*.xl*")
Do While MyFile <> ""
Workbooks.Open FileName:=MyFolder & "\" & MyFile, ReadOnly:=True
MyFile = Dir
Loop
For Each WkBk In Workbooks 'Loops through each open workbook
If Not WkBk.Name = ThisWorkbook.Name Then 'If not this master workbook
For Each WkShtUser In WkBk.Worksheets 'Loops through each worksheet in the current workbook
Select Case WkShtUser.Name 'Worksheet name for Month
Case "Jan" 'Jan is the worksheet name for the monthly tab/sheet in the users individual file
Set WkShtMaster = M_01 'M_01 is the CodeName of the monthly worksheet in Master file
Case "Feb"
Set WkShtMaster = M_02
Case "Mar"
Set WkShtMaster = M_03
Case "Apr"
Set WkShtMaster = M_04
Case "May"
Set WkShtMaster = M_05
Case "Jun"
Set WkShtMaster = M_06
Case "Jul"
Set WkShtMaster = M_07
Case "Aug"
Set WkShtMaster = M_08
Case "Sep"
Set WkShtMaster = M_09
Case "Oct"
Set WkShtMaster = M_10
Case "Nov"
Set WkShtMaster = M_11
Case "Dec"
Set WkShtMaster = M_12
Case Else
GoTo NextWkSht
End Select
PasteAtRow = WkShtMaster.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row + 1 'find first empty row in master sheet for appropriate month
With WkShtUser 'Clear autofilter, if on, and copy designated columns of data from row 2 through last row
If .FilterMode = True Then .AutoFilterMode = False
CopyToRow = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
If CopyToRow = 1 Then GoTo EmptyWkSht
.Range("A2", "Z" & CopyToRow).Copy 'Where "Z" is the lst column of data you want to copy
End With
WkShtMaster.Range("A" & PasteAtRow).PasteSpecial xlPasteValues 'Paste data to empty rows in master for appropriate month
EmptyWkSht:
If Not WkShtMaster Is Nothing Then Set WkShtMaster = Nothing
CopyToRow = 0
PasteAtRow = 0
NextWkSht:
Next
WkBk.Saved = True
WkBk.Close False
End If
Next
Oops:
If Err Then
Debug.Print Err.Description
MsgBox "Refresh Error:" & vbNewLine & vbNewLine & Err.Description, vbCritical, "Error..."
Else
MsgBox "Refresh Completed Successfully", vbInformation, "Refresh Complete..."
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub