子程序,用于导入其代码片
问题描述:
我得到此代码工作一段时间,但最后几天它没有工作。从活动workbook1它假设进口sheetworkThisworkbook2:子程序,用于导入其代码片
Sub ImportallWBsh()
'https://michaelaustinfu.files.wordpress.com/2013/03/excel-vba-for-dummies-3rd-edition.pdf, Page 245
Dim Finfo As String
Dim FilterIndex As Integer
Dim Title As String
Dim Filename As Variant
Dim wb As Workbook
'Setup the list of file filters
Finfo = "Excel Files (*.xlsx),*xlsx,"
'Display *.* by default
FilterIndex = 1
'Set the dialog box caption
Title = "Select a File to Import"
'Get the Filename
Filename = Application.GetOpenFilename(Finfo, _
FilterIndex, Title)
'Handle return info from dialog box
If Filename = False Then
MsgBox "No file was selected."
Else
MsgBox "You selected " & Filename
End If
On Error Resume Next
Set wb = Workbooks.Open(Filename)
FilenameWorkbook.Sheets.Copy _
After:=ThisWorkbook.Sheets("Sheet3")
wb.Close True
ThisWorkbook.Sheets("Sheet1").Select
End Sub
你知道什么可能是错的。 谢谢
答
你有一对夫妇的问题,怎么回事...
您正在使用Set
不正确。 GetOpenFileName
返回一个字符串。 Workbooks.Open
返回一个对象。检查this了。你可以在阅读第一部分:
s = Application.GetOpenFilename()
Set Wb1 = Workbooks.Open (s)
你还打开工作簿s
两次,再加上你创建对象objexcel
它创建的Excel中的一个新的实例,但你不Set objexcel = Nothing
关闭它,所以每次你运行代码,你会在后台打开另一个Excel副本。
(关闭Excel,然后CTRL + ALT + DEL 到检查你的任务管理器,我敢打赌,你会明白我的意思!)
首先我建议你试试this search,其中将显示针对已为其他人工作的相同问题的多种解决方案,例如this和this。
答
像这样的东西应该为你做这项工作。
Sub Basic_Example_1()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, Fnum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long
'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"
'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'Add a new workbook with one sheet
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 1
'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0
If Not mybook Is Nothing Then
On Error Resume Next
With mybook.Worksheets(1)
Set sourceRange = .Range("A1:C1")
End With
If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
Else
'if SourceRange use all columns then skip this file
If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
Set sourceRange = Nothing
End If
End If
On Error GoTo 0
If Not sourceRange Is Nothing Then
SourceRcount = sourceRange.Rows.Count
If rnum + SourceRcount >= BaseWks.Rows.Count Then
MsgBox "Sorry there are not enough rows in the sheet"
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else
'Copy the file name in column A
With sourceRange
BaseWks.cells(rnum, "A"). _
Resize(.Rows.Count).Value = MyFiles(Fnum)
End With
'Set the destrange
Set destrange = BaseWks.Range("B" & rnum)
'we copy the values from the sourceRange to the destrange
With sourceRange
Set destrange = destrange. _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
rnum = rnum + SourceRcount
End If
End If
mybook.Close savechanges:=False
End If
Next Fnum
BaseWks.Columns.AutoFit
End If
ExitTheSub:
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
答
正确的行代码需要:
ActiveWorkbook.Sheets.Copy _
After:=ThisWorkbook.Sheets("Hoja3")
因此,代码正常工作。谢谢
@ YowE3K - oops, 更正,谢谢。 – ashleedawg
我在阅读推荐的搜索和其他一些材料几天之后得到了代码。我真的很感谢谢谢。现在我想向您展示代码现在的样子如何获取更多的见解或建议我是否可以在此处编辑我的帖子,或者是否有任何其他方式可以在此处发布我的代码,以便您可以查看它?谢谢 – Sergio
不客气!嗯,好问题。正如你可能已经知道的,这里有些人对发布某些方式非常挑剔。 (今天别人的问题被删除了,因为** I **发布了一张图片作为答案,当时只是要求澄清!(我对这个问题提问者感觉不好)但是,我希望看到您的代码。我认为如果你编辑**你的原始问题,并在**结尾**处放置:“更新:”,并附上简短的解释和你的代码,那就没问题了。 – ashleedawg