我的宏的VBA代码出现问题,我想打开msoFileDialogFolderPicker,用户选择一个文件夹,其中将打开所有excel文件,并从新打开的工作簿中复制逐个数据粘贴到运行宏的工作簿中的特定工作表中。基本上,我们为每个销售代表提供一个电子表格来填写他们的销售,然后他们将他们的电子表格提交给销售经理。我想要做的不是必须打开每个电子表格并复制数据并将所有数据手动粘贴到一个电子表格中,而是只需要一个宏来为我做这个。由于文件的位置和名称可以更改,我试图使其尽可能动态。可能有更好的方法,所以任何建议都非常感谢!
我遇到的问题是我将文件打开并复制,但后来我得到了运行时错误1004'范围类的复制方法失败'当我尝试将其粘贴到运行宏的工作簿中时。我尝试过ThisWorkbook和ThisWorkbook.Activate尝试告诉Excel转到宏运行的电子表格,但没有解决我的问题。有时我会通过错误,但它仍然永远不会将数据粘贴到主工作簿中。我的代码写在下面。不可否认,它主要是从我找到的代码中复制而来,但我试图根据我的目的进行调整。我收到错误的那一行是" wb1.Worksheets(1).Range(" A5")。选择"线。
Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim wb1 As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
myExtension = "*.xls*"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
Set wb = Workbooks.Open(Filename:=myPath & myFile)
Set wb1 = ThisWorkbook
Do events
wb.Worksheets(1).Range("A5:H28").Select
Selection.Copy
wb1.Activate
wb1.Worksheets(1).Range("A5").Select
ActiveSheet.Paste
DoEvents
myFile = Dir
Loop
MsgBox "Task Complete!"
ResetSettings:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
这是我最终要做的简化版本,其中包括从新打开的工作簿中的多个工作表中复制内容并将其粘贴到最初运行宏的工作簿的多个工作表中。然而,在这一点上,我只是想让这个简单的版本运行和工作。感谢大家的帮助和对长代码的道歉,但我想让大家知道我在做什么。谢谢!
答案 0 :(得分:0)
停止使用Select
和Activate
并编写使用Selection
的代码 - 这是宏录制器的代码。你不是一个宏录音机,你可以编写比这更好的代码。
这做了太多事情,并使用Object
处理后期绑定调用来捕获你,这意味着你在没有 IntelliSense 的任何帮助的情况下盲目地输入代码,没有自动完成,没有工具提示:
wb.Worksheets(1).Range("A5:H28").Select
你想要一个Range
对象。
Dim source As Range
Set source = wb.Worksheets(1).Range("A5:H28")
现在,当您输入source.
时, IntelliSense 可以为您提供帮助。继续,尝试:
source.Copy[space]
请注意工具提示,告诉您可以在那里指定目的地。
所以制作另一个范围:
Dim destination As Range
Set destination = wb1.Worksheets(1).Range("A5")
然后复制吧!
source.Copy destination
现在,您应该在该循环结束前调用wb.Close
...